;SCREEN	
								
onebitm	= 25256		;größe 1 bitplane (287 lines *88)
scrnmem	= onebitm*8		;größe hole bitplanes
vstrt	= $1a		;start vertikal
hstrt	= $6b		;start horizontal
vstop	= $38		;stop vertikal
hstop	= 202		;stop horizontal
ddfstrt	= $18+$18		;ddfstrt

					;CHIP-BASES
c	= $dff000		;custom-chips base
c1	= $bfe001		;cia A base
c2	= $bfd000		;cia B base

					;INIT
	
	move.l $4,a6	;kernel-base
	bsr initdosfil	;init dos filing system
	bsr loadcharset	;load charset
;	bsr loadsample	;load sample
;	bsr loadmfmt	;load mfm-tables
wait
	move.w c+$16,d0	;right mouse-button?
	btst #10,d0
	bne.s wait

	jsr -132(a6)	;forbid task-switching

	bsr copchipm	;copy chip-mem
	bsr initkeys	;init keys-system
	bsr initscrn	;init screen
	bsr initcharset	;init charset
	bsr initaudio	;init audio
	bsr snirqs		;set new exceptions

					;MAIN

;	bsr DOS_INST
;	clr.w d0
;	bsr DOS_CDRIVE
	bsr revoff
	bsr loop		;main-loop
		
	clr.b c1+$300
	
					;LEAVE

;	bsr DOS_RES	

	bsr rsaudio		;reset audio
	bsr rsirqs		;reset interrupts
	bsr reskeys		;reset keys
	bsr rsscrn		;reset screen
	bsr crushchars	;crush charset
;	bsr crushsample	;crush sample
	bsr schipmf		;set chip-mem free
	bsr schsctabf	;set chars-scrn table free
;	jsr charmemf	;set char-mem free
		
	jsr -138(a6)	;permit tasks
	clr.l d0
	rts


loop

;prepare main-term
	clr.l Main_Term_Length
	move.l #$10000,d0
	bsr rfastm
	move.l d0,Main_Term_Addr


pred_txt_leng = 76

	clr.w d5
2$			;input
	move.b d5,d0
	add.b scays+1,d0
	move.b d0,pcupy
	move.b scaxs+1,pcupx
	lea.l 5$,a1
	bsr ptext

	lea.l txt,a2
	move.b #$80,(a2)
	moveq.w #0,d3
	moveq.w #1,d4
	move.w #pred_txt_leng+1,d2
	bsr LINE_ED
			;next line
	move.w scaye,d0
	sub.w scays,d0
	cmp.w d0,d5
	bhs.s 1$
	addq.w #1,d5
	bra.s 4$
1$	bsr linup
4$			;test on end
	cmp.l #$444d4380,(a2)
	beq 6$
	bra 2$
			;test on "set sign"
	cmp.l #$45408080,(a2)
	bne.s 8$
	clr.w 9$
	bra.s 2$
	cmp.l #$56408080,(a2)
	bne.s 8$
	move.w #1,9$
	bra.s 2$
8$			;add term
	move.l a2,a0
	move.w 9$,d2
	move.w #pred_txt_leng,d0
	bsr Add_Predicate

			;Computer´s Advise
	move.b d5,d0
	add.b scays,d0
	subq.b #1,d0
	move.b d0,pcupy
	move.b #40,pcupx
	ext.w d7
	ext.l d7
	asl.b #3,d7
	add.l #7$,d7
	move.l d7,a1
	bsr ptext
	move.l Main_Term_Length,d1
	bsr prhexl

	movem.l d0-d7/a0-a6,-(a7)
	clr.b pcupx
	clr.b pcupy
	addq.b #5,pcupx
	addq.b #3,pcupy
	move.l Main_Term_Addr,a1
	move.w #20,d5
;	bsr prmonlin
	movem.l (a7)+,d0-d7/a0-a6
	
			;next
	bra 2$
6$

	move.l Main_Term_Addr,a1
	move.l #$10000,d0
	jmp -210(a6)

	rts

5$	dc.w $0c80

7$	dc.l $45118000,0
	dc.l $56118000,0
9$
	dc.w 1


	bsr getkey
	tst.b d0
	move.b d0,txt
	cmp.b #$80,d0
	beq.s n5

	move.w #$0001,c+$96	;audio-channel 0 off

	lea txt,a1
	bsr ptext


	move.w #$40,c+$a8	;set volume
	move.w #$8001,c+$96	;audio-channel 0 on
	move.w #$8080,c+$9a	;audio-interrupt 0 enable

	move.b pcupy,d0
	move.b pcupx,d4
	move.b d0,cupy
	move.b d4,cupx

	bsr swcuon

	move.b txt,d0
	and.b #$3f,d0
	swap d0
	move.w #0,d0
;	bsr ReadTrack

n5
	btst #6,c1		;right mouse-button?
	bne loop
	rts		;yes: fuck off

txt	dc.l $80808080,$80808080,$80808080,$80808080,$80808080
	dc.l $80808080,$80808080,$80808080,$80808080,$80808080
	dc.l $80808080,$80808080,$80808080,$80808080,$80808080
	dc.l $80808080,$80808080,$80808080,$80808080,$80808080

initaudio				;INIT AUDIO

	move.w #$0003,c+$96	;audio-channels off

	move.l samplebase,c+$a0	;set sample-data
	move.w #7650/12,c+$a4

	move.w #$0,c+$a8	;set volume
	move.w #$ff,c+$9e	;modulation off
	
	move.w #$c0,c+$a6	;set sample-period	
	rts
	
rsaudio				;RESET AUDIO

	move.w #$0003,c+$96	;audio-channels off
	rts

schipmf				;SET MEM FREE

	move.l cmbase,a1	;address
	move.l #cme-cms,d0	;quantity
	jmp -210(a6) 	;free mem

schsctabf				;SET CHARS-SCREEN TABLE FREE
	
	move.l lintaba,a1	;get address
	move.l cstabqu,d0	;get quantity
	jmp -210(a6)	;free mem
	
rsscrn				;RESET SCREEN
			
	move.l scrnaddr,a1	;screen-address
	move.l #scrnmem,d0	;quantity
	jsr -210(a6)	;set mem free
	
	lea gname,a1	;graphics-lib
	clr.l d0		;version
	jsr -552(a6)	;open library

	move.l d0,a0	;set new copper-list:
	move.l 38(a0),c+$80
	clr.w c+$88
	
	move.w #$83f0,c+$96	;dma-canels on
	rts

initscrn				;INIT SCREEN

	clr.w c+$108	;clr modulo-werte screen
	clr.w c+$10a
	move.w #$ff,c+$102
	
	move.w #vstrt*$100+hstrt,c+$8e	;diwstrt vert./hor.
	move.w #(vstop+1)*$100+hstop+1,c+$90	;diwstop vert./hor.
	move.w #ddfstrt,c+$92		;ddfstrt hor.
	move.w #$d8,c+$94		;ddfstop hor.
	move.w #$9000,c+$100		;grfx-mode: hires 1 plane
	
	move.w #$07ff,c+$96	;dma off	
	move.l cmbase,d0	;copper-list address
	add.l #clist-cms,d0
	move.l d0,c+$80
	clr.w c+$88
	move.w #$87c0,c+$96	;dma on: copper,blitter,bit-plane,bl.-priority	

	move.l #scrnmem,d0	;screen-area
	bsr rchipm		;chip-mem anfordern
	move.l d0,scrnaddr	;save scrn-base

	clr.w c+$42		;bltcon1: copy data

	bra copct		;copy colors
	
sscrna				;SET SCREEN-ADDR IN COPPER-LIST

	move.l cmbase,a1	;copper-list base
	move.l lintaba,a0	;get line-table addr

	move.w charsy,d0	;char/column
	subq.w #1,d0	;-1 = counter
	
n181			;copy addrs:
	move.w (a0)+,sczeih1-cms(a1)	;set hi-addr
	move.w (a0)+,sczeil1-cms(a1)	;set lo-addr

	tst.b sczeil1-cms+3(a1)	  ;test x-wait
	bpl.s n183		   ;ok, skip
	addq.l #4,a1	  ;y-overflow: copper-pointer +4
n183
	add.l #6*2,a1	  ;modify copper-pointer
	dbra.w d0,n181	  ;next line
	
	rts

scopwaitl				;SET COPPER WAIT-LINES

	move.l cmbase,a1	;copper-list base
	add.l #waitlin-cms,a1	;+ wait-line-offset

	move.w charsy,d0	;char/column
	subq.w #1,d0	;-1 = counter

	move.b #25,d1	;set first line

n182			;set copper wait-lines:
	move.b d1,(a1)+	  ;set line
	move.b #$0f,(a1)+	  ;set x
	move.w #$fffe,(a1)+	  ;set wait-code
	
	move.l #$00e00000,(a1)+	  ;set move-scrnaddr hi
	move.l #$00e20000,(a1)+	  ;set move-scrnaddr lo

	add.b chsizey+1,d1	  ;modify line
	bcc.s n184		  ;overflow? \no: skip
	move.l #$ffe1fffe,(a1)+	   ;yes: set wait y-msb
n184
	dbra.w d0,n182	  ;next line

	move.w #$ffff,waitlin-cms(a1)	;set impossible line
	rts
	
copct				;COPY COLOR-TABLE

	lea coltab,a0	;set pointers
	lea c+$180,a1
n1	
	move.w (a0)+,(a1)+	;copy
	bpl n1
n23	rts

rfastm				;RESERVE FAST-MEM
;in: d0 = quantity (bytes)
;out: d0 = address

	move.l d0,d2	;rescue d0

	moveq #4,d1		;4 ^ fast-mem
	jsr -198(a6)	;alloc mem
	
	tst.l d0		;mem allocated?
	bne.s n23		;yes: leave

	move.l d2,d0	;no: get quantity & reserve chip-mem	

rchipm				;RESERVE CHIP-MEM
;in: d0 = quantity (bytes)
;out: d0 = address

	move.l #$10002,d1  	;2 ^ chip-mem (& clear)
	jmp -198(a6)	;alloc mem

copchipm				;COPY CHIP-MEM	

			;mem anfordern:
	move.l #cme-cms,d0	  ;quantity
	jsr rchipm		
			;copy mem:
	move.w #(cme-cms)/2-1,d1  ;zähler
	move.l d0,a1	  ;destination
	move.l d0,cmbase	  ;& retten
	lea cms,a0		  ;source
n3			  
	move.w (a0)+,(a1)+	  ;copy
	dbra d1,n3
	rts

chexct				;CHANGE EXCEPTION-TABLE
	
	move.w #$7fff,c+$9a	;interrupts disable
	move.w #$7fff,c+$9c
	
	lea 0,a0		;get pointers
	lea exctab,a1
	move.w #48-1,d1	;zähler: 48 durchläufe
n8
	move.l (a0),d0	;change pointers
	move.l (a1),(a0)+
	move.l d0,(a1)+

	dbra d1,n8		;loop
	rts
	
snirqs				;SET NEW INTERRUPTS
	
	jsr -120(a6)	;interrupts disable

	move.w c+$1c,d0	;rescue i-register
	ori.w #$8000,d0
	move.w d0,istat

	jsr chexct		;change exception table
	move.w #$c0a8,c+$9a	;interrupt on: v-blank,cia A,audio 0

	rts

getkey				;GET KEY
;out: d0 = (b) pressed key in fas-code

	move.w #$0008,c+$9a	;keys-interrupt off

	move.b inkey,d0	;get inkey
	move.b #$80,inkey	;reset inkey (no-info code)

	move.w #$8008,c+$9a	;keys-interrupt on
	rts

initkeys				;INIT KEYBOARD

			;rescue cia A registers:
	move.b c1+$e00,sciaaca	  ;save control register A

	move.b #$10,c1+$e00	  ;timer A: stop & reload
	move.b c1+$400,sciaatal	  ;save timer A lo
	move.b c1+$500,sciaatah	  ;save timer A hi

	
	and.b #$bf,c1+$e00	;serial-port mode in

			;set interrupt:
	move.b #$7f,c1+$d00	  ;clr mask-register
	move.b c1+$d00,d0	  ;clr data-register
	move.b #$88,c1+$d00	  ;set sp-interrupt
	
			;set timer A:
	move.b #$02,c1+$400	  ;set latch lo
	move.b #$00,c1+$500	  ;set latch hi
	clr.b c1+$e00	  ;sp in

			;init key-pars:
	
initkeyp				;INIT KEY-PARAMETERS

	move.b #$80,curkey	;reset current key
	clr.b levkey	;reset current level-keys

	rts

reskeys				;RESET KEYS

	move.b sciaatal,c1+$400	;reload cia A timer A lo
	move.b sciaatah,c1+$500	;reload cia A timer A hi

	move.b sciaaca,c1+$e00	;reload cia A control-reg. A

	tst.b c1+$d00	;reset cia A i-request
	move.b #$8b,c1+$d00	;set cia A i-mask
	rts
		
rsirqs				;RESET INTERRUPTS
			
	bsr chexct		;change exception-table
	move.w istat,c+$9a	;reset i-register
	
	jmp -126(a6)	;interrupts enable


setchpar				;SET CHAR-PARAMETERS
;in: d0 = (w) char size y/x
;in: d1 = (w) char-data length/width 

			;set char-size:
	move.w d0,chsizex	  ;x
			
	swap d0		  ;y:
	move.w d0,chsizey

			;set total char-mask (-widht):
	move.w #$8000,tchmask	  ;prepare total charmask
	swap d0		  ;get char-size x
	subq.w #2,d0	  ;& -2
n22
	asr tchmask		  ;increment width of char-mask
	dbcs d0,n22		  ;width -1 & loop

			;set clr-char blit-mask base:
	move.l cmbase,ccbmbas	  ;chip-mem base
	add.l #clrchbm-cms,ccbmbas ;+ offset clrchbm-addr

			;set clr-char blit-mask data:
	move.l ccbmbas,a0	  ;get ccbm-addr
	
	move.l d1,d3	  ;get char-length to count
	swap d3
n21
	move.l tchmask,(a0)+	  ;set total char-mask
	dbra d3,n21		  ;char-lenght -1 & loop
	
			;set char-mask (^ char-width):
	move.w #$8000,charmask	  ;prepare charmask
	subq.w #2,d1	  ;char-width -2
n20
	asr charmask	  ;increment width of char-mask
	dbcs d1,n20		  ;width -1 & loop
	
			;set blitter-size:
	clr.w d1		  ;reset d1 lo-word
	lsr.l #8,d1		  ;length into bits 5-15 (blit y-size)
	lsr.w #2,d1
	or.b #2,d1		  ;set blit x-size (= 2)
	move.w d1,chbsize	  ;set blit-size

			;set modulo-values:
	move.w #252,chbmods	  ;source A = 256 -2 (bytes)
	
	move.w scrnwidth,chbmodd  ;destination D: scrn-width (bytes)
	subq.w #4,chbmodd	    ;-4

			;set charbas:
;	move.l cmbase,charbas	  ;chip-mem base
;	add.l #charset-cms,charbas ;+ offset charbase-addr

	rts			

inchsctab				;INIT CHARS-SCREEN TABLE

	lea ssccp,a0	;get chars/line
	bsr gcharsl
	
	lea ssccp+2,a0	;get chars/column
	bsr gcharsl
			;get chars/screen:
	move.w charsx,d0
	mulu charsy,d0	  ;chars/column * chars/line
	move.w d0,charssc	  ;set product (chars/scrn)

			;reserve mem for table:
	move.w charsx,d0	  ;chars/line
	asl.w #2,d0		  ;*4 bytes

	clr.l d3		  ;prepare d3
	move.w charsy,d3	  ;chars/column
	asl.b #2,d3		  ;*4 bytes
	
	add.w d3,d0		  ;total => quantity
	move.l d0,cstabqu	  ;rescue quantity
	bsr rfastm		  ;alloc fast-mem
	
	move.l d0,lintaba	  ;rescue line-table addr 
	move.l d0,a1	  
	add.l d3,d0		  ;+ offs line-table
	move.l d0,coltaba	  ;rescue column-table addr

			;calculate line-table:
	clr.w d3		  ;reset line-counter
n25
	move.w d3,d0	  ;get line
	swap d0
	clr.w d0		  ;column = 0

	bsr gchpsca		  ;get screen-addr
	move.l a0,(a1)+	  ;line scrn-addr into line-tab

	addq.b #1,d3	  ;next line	  
	cmp.b charsy+1,d3	  ;all lines calculated?
	blo.s n25		  ;no: loop 

			;calculate column-table:
	clr.w d3		  ;reset column-counter 
n26
	clr.l d0		  ;line = 0
	move.w d3,d0	  ;get column
	
	bsr gchpsca		  ;get screen-addr
	
	sub.l scrnaddr,a0	  ;- screen-base
	move.w a0,(a1)+	  ;scrn column-offs into column-tab

	ror.w #4,d0		  ;barrel shift into bits 12-15
	move.w d0,(a1)+	  ;barr. shft into column-tab

	addq.b #1,d3	  ;next# column
	cmp.b charsx+1,d3	  ;line ready?
	blo.s n26 		  ;no: loop
			  
	bsr scopwaitl	;set copper wait-lines
	bra sscrna		;set scrn-addrs in copper-list
	

gcharsl			;get chars/line or chars/column
			;------------------------------
;attention: routine very styled!
;in: a0 = addr ssccp (x-mode) or addr ssccp +2 (y-mode)

	clr.l d0		  ;get scrn-width
	move.w scrnwidth-ssccp(a0),d0
	
	move.w sscc-ssccp(a0),d1  ;get special scrn-char const.
	asl.w d1,d0		  ;* scrn-width = pixel/line
	
	divu chsizex-ssccp(a0),d0  ;pixel/line / total char-width
	move.w d0,charsx-ssccp(a0) ;set number chars x

	swap d0		  ;get rest
	lsr.w #1,d0		  ;& bisect
	move.w d0,chfinepx-ssccp(a0)  ;set chars fine-position x
	
	rts

gclocat			;GET LOCATE-VALUES BY CHECKING BOUNDS
;in: d0 = (b) line-offset to y-area
;in: d4 = (b) column-offset to x-area
;out: d0 = (w:b/b) column-line

	lea ssccp+2,a0	;get y-mode
	bsr.s getloc	;get location
	exg d0,d4		;save y-location & load x-offs
	
	tst.w -(a0)		;get x-mode (a0 -2)
	bsr.s getloc	;get location
	
	swap d0		;x-location into hi
	move.b d4,d0	;y-location into lo
	rts

getloc				;get location x/y
				;----------------
	bsr.s gsclim	;get limits scrn-area x/y

	bra.s n48b		;ÄNDERUNG !!!

	tst.b d0		;offset negative?
	bpl.s n48		 ;no: locate on right side
			 ;yes: locate on left side:
	add.b d2,d0		;offs + end-limit
	bra.s chkbub	;check location & modify underflow
n48
	add.b d1,d0		;offs + start-limit
n48b	bra.s chkbob	;check location & modify overflow

sscareax				;SET SCRN-AREA X
;{look sscarea d0,d4}

	lea ssccp,a0	;get x-mode
	bra.s sscarea	;set area
	
sscareay				;SET SCRN-AREA Y
;{look sscarea d0,d4}

	lea ssccp+2,a0	;get y-mode
			;set area:
			
sscarea				;SET SCRN-AREA X/Y
;in: d0 = (b) start
;in: d4 = (b) end
;in: a0 = x/y mode (ssccp/ssccp+2)

	bsr.s gsclim	;get limits scrn-area x/y
	
			;set scrn-area x/y:
	bsr.s chkbub	  ;check start
	move.b d0,scaxs+1-ssccp(a0) ;set start
	
	move.b d4,d0	  ;get end
	bsr.s chkbob	  ;check end
	move.b d0,scaxe+1-ssccp(a0) ;set end
	
	rts
	

gsclim				;GET LIMITS SCRN-AREA X/Y
;in: a0 = x/y mode (ssccp/ssccp+2)
;out: d1/d2 = (b) start/end 

	move.b scaxs+1-ssccp(a0),d1	;get start x/y
	move.b scaxe+1-ssccp(a0),d2	;get end x/y
	rts
	
chkbob			;CHECK BOUNDS & MODIFY OVERFLOW, BYTE
;{analogic to chkbl}

	bsr.s chkbb		;check bounds, byte
	bra.s modov		;modify overflow

chkbub			;CHECK BOUNDS & MODIFY UNDERFLOW, BYTE
;{analogic to chkbl}

	bsr.s chkbb		;check bounds, byte
	bra.s modun		;modify underflow

chkbow			;CHECK BOUNDS & MODIFY OVERFLOW, WORD
;{analogic to chkbl}

	bsr.s chkbw		;check bounds, word
	bra.s modov		;modify overflow

chkbuw			;CHECK BOUNDS & MODIFY UNDERFLOW, WORD
;{analogic to chkbl}

	bsr.s chkbw		;check bounds, word
	bra.s modun		;modify underflow

chkbol			;CHECK BOUNDS & MODIFY OVERFLOW, L-WORD
;{analogic to chkbl}

	bsr.s chkbl		;check bounds, l-word
	bra.s modov		;modify overflow

chkbul			;CHECK BOUNDS & MODIFY UNDERFLOW, L-WORD
;{analogic to chkbl}

	bsr.s chkbl		;check bounds, l-word
	bra.s modun		;modify underflow

modov				;MODIFY OVERFLOW
;in: {analogic to chkbl}
;in: z-flag: {analogic to chkbl, out}

	beq.s n46		;overflow? /no: leave
	move.l d2,d0	 ;yes: date = limit end
n46		
	rts	 
	
modun				;MODIFY UNDERFLOW
;in: {analogic to chkbl}
;in: z-flag: {analogic to chkbl, out}

	beq.s n47		;underflow? /no: leave
	move.l d1,d0	 ;yes: date = limit start
n47		
	rts
	
chkbb				;CHECK BOUNDS, BYTE
;{analogic to chkbl}

	ext.w d0		;extend bytes
	ext.w d1
	ext.w d2
	ext.w d4
			;check bounds, word:

chkbw				;CHECK BOUNDS, WORD
;{analogic to chkbl}

	ext.l d0		;extend words
	ext.l d1
	ext.l d2
	ext.l d4
			;check bounds, l-word:

chkbl				;CHECK BOUNDS, LONG-WORD
;in: d0 = (l) date
;in: d1 = (l) limit start  
;in: d2 = (l) limit end
;out: z-flag = 0 ^ date in area

			;set conditions:
	cmp.l d2,d0		  ;date > end?
	shi bcon1		   ;yes: set bound-condition 1
	cmp.l d1,d0		  ;date < start?
	slo d3		   ;yes: set bound-condition 2

	cmp.l d1,d2		;end < start?
	blo.s n45		 ;yes: compare-mode 2
			;no: compare-mode 1:
	or.b bcon1,d3	  ;z = (d>e) or (d<s)
	rts
n45			;compare-mode 2:
	and.b bcon1,d3	  ;z = (d>e) and (d<s)
	rts
	
bcon1	dc.b 0		;bound-condition 1
	dc.b 0

pchar				;PRINT CHAR
;attention: don´t modify a0 (x-counter)
;in: d1 = char
				;print char 1 bitmap
				;-------------------
			;get char-data addr:
	and.l #$7f,d1	  ;mask char
	asl.b #1,d1		  ;*2 bytes
	add.l charbas,d1	  ;+ char-base	

			;get destination-addr (scrn):
	move.w (a0)+,d0	  ;get column scrn-offs
	ext.l d0		  ;extend to l-word
	add.l csclina,d0	  ;+ current line scrn-addr
	
n126	btst #14,c+$02	;blitter busy?
	bne.s n126		;yes: loop
	
			;set blit-addresses:
	move.l d0,c+$54	  ;set target D: screen
	move.l d0,c+$48	  ;& source C: screen
	move.l d1,c+$50	  ;set source A: charset
	move.l ccbmbas,c+$4c	  ;set source B: clr-char blit-mask

			;set blit-modes:
	move.w (a0)+,d0	  ;get barrel shift
	move.w d0,c+$42	  ;set bar.shft B & ascending mode

	or.w bltcon0,d0	  ;dma-canels & miniterms
	move.w d0,c+$40	  ;set bltcon0
	
	move.w chbsize,c+$58	;set size (& start blitter)
	rts

spchx				;SET PCHAR COLUMN
;in: d0 = (b) column

	and.l #$ff,d0	  ;mask column
	asl.w #2,d0		  ;column *4 bytes
	move.l coltaba,a0	  ;get column-table addr
	add.l d0,a0		  ;+ column-offs
	rts

spchlin				;SET PCHAR-LINE
;in: {look spchlin2}+

	bsr swcuoff		;switch cursor off

spchlin2				;SET PCHAR-LINE 2
;in: d0 = (w) line/bltcon0

n24	btst #14,c+$02	;blitter busy?
	bne.s n24		;yes: loop

	tst.b bltopmod	;blit-op mode = copy char?
	beq.s n27		 ;yes: skip
			 ;no: prepare blit char-copy:
			;set modulo-values:
	move.w chbmods,c+$64	  ;source A (char-data)
	clr.w c+$62		  ;source B (clr-char mask)
	move.w chbmodd,c+$60	  ;source C (screen)
	move.w chbmodd,c+$66	  ;destination D (screen)	

	move.w charmask,c+$44	;set first word mask A
	clr.w c+$46		;set last word mask A	
n27
	move.w d0,bltcon0	;set blitter-control 0

			;get line-addr:
	swap d0		  ;get line
	and.l #$ff,d0	  ;mask line
	
	asl.b #2,d0		  ;line *4 bytes	
	move.l lintaba,a0	  ;get line-table addr
	add.l d0,a0		  ;+ line-offs
	
	move.l (a0),csclina	  ;rescue line scrn-addr
	rts

revon				;PRINT-TEXT REVERSE ON

	move.w #$0f2e,pmode	;set print-mode
	rts
	
revoff				;PRINT-TEXT REVERSE OFF

	move.w #$0fe2,pmode	;set print-mode
	rts

activprm				;ACTIVATE PRINT-MODE

	move.b pcupy,d0	;get pcu y
	move.b pcupx,d4	;get pcu x
			;locate pcu:
	
locpcu				;LOCATE PRINT-CURSOR
;in: d0 = (b) line-offs against y-limits
;in: d4 = (b) column-offs against x-limits

	bsr swcuoff		;switch cursor off

	bsr gclocat		;get location & check bounds

	move.b d0,pcupy	;set print-cu pos y
	swap d0		;get column
	move.b d0,pcupx	;set print-cu pos x
	
	move.w pmode,d0	;get blit-control 0 
	bsr spchlin		;set pchar-line

	move.b pcupx,d0	;get column
	bra spchx		;set pchar column

ptext
	movem.l d0-d5/a1-a2,-(a7)
	bsr ptext_2
	movem.l (a7)+,d0-d5/a1-a2
	rts

ptext_2				;PRINT TEXT
;in: a1 = text-addr
			;register-save
;	movem.l d0-d5/a1-a2,-(a7)

	bsr.s activprm	;activate pr-mode
n51	
	move.b (a1)+,d1	;get code
 	bmi n50		;code = char? /no: skip
			 ;yes:
	bsr pchar		;print char
	bsr cright		;pcu right
	bra.s n51		;next code

n50
	cmp.b #$c0,d1	;code >= $c8?
	bhs.s n51		 ;yes: no function-code: loop
	
	cmp.b #$80,d1	;end-marker?
;	beq swcuon		 ;yes: switch cu on & leave
	beq n186
			;on code jsr...:
	asl.b #2,d1		  ;code *4
	and.l #$01ff,d1	  ;mask code
	lea castab1,a2	  ;get case-table base
	add.l d1,a2		  ;+ offset case (code)
	move.l (a2),a2	  ;get jump-addr
	jsr (a2)		  ;jump subroutine
	
	bra.s n51		;next code

castab1			;case-table:
	dc.l messend
	dc.l fkey
	dc.l fkey	
	dc.l fkey
	dc.l fkey
	dc.l fkey
	dc.l fkey
	dc.l fkey
	dc.l fkey
	dc.l fkey
	dc.l fkey
	dc.l help
	dc.l fkey
	dc.l fkey
	dc.l fkey
	dc.l fkey

	dc.l ret
	dc.l esc
	dc.l messend; del
	dc.l backspc
	dc.l messend; tab
	dc.l cup
	dc.l cdown
	dc.l cleft
	dc.l cright
	dc.l n51
	dc.l n51
	dc.l n51
	dc.l n51
	dc.l n51
	dc.l n51
	dc.l n51

	dc.l messend
	dc.l fkey
	dc.l fkey	
	dc.l fkey
	dc.l fkey
	dc.l fkey
	dc.l fkey
	dc.l fkey
	dc.l fkey
	dc.l fkey
	dc.l fkey
	dc.l help
	dc.l fkey
	dc.l fkey
	dc.l fkey
	dc.l fkey

	dc.l ret
	dc.l esc
	dc.l messend; del
	dc.l backspc
	dc.l messend; tab
	dc.l cup
	dc.l cdown
	dc.l cleft
	dc.l cright
	dc.l n51
	dc.l n51
	dc.l n51
	dc.l n51
	dc.l n51
	dc.l n51
	dc.l n51

help			;change underline-mode:
	move.l cmbase,a2
	move.b clrchbm-cms(a2),d1
;	eor.b d1,clrchbm+(8*4)-cms(a2)
n186
	rts	

esc			;change invert-mode:
	move.b pmode+1,d1
	rol.b #4,d1
	move.b d1,pmode+1
	rts

retshft			;shift return:
			;-------------
	move.b scaxs+1,pcupx	  ;pcu x = window x start
	bra.s cdown		  ;pcu down

ret			;return:
			;-------
	move.b scaxs+1,pcupx	  ;pcu x = window x start
	bsr cdown		  ;pcu down
	
	move.w scays,-(a7)	  ;save window start y 
	move.b pcupy,scays+1	  ;window start y = pcu y
	bsr lindown		  ;scroll one line down
	move.w (a7)+,scays	  ;load window start y

	rts
	
cdown			;pcu down:
			;---------
	move.b pcupy,d1	  ;pcu y = window y end?
	cmp.b scaye+1,d1
	bhs.s cd2		   ;yes: scroll one line up
			   ;no:
	addq.b #1,pcupy	  ;increment pcu y
	bra activprm	  ;activate pr-mode
cd2
	bsr linup		  ;line up
	bra activprm	  ;activate pr-mode
	
cup			;pcu up:
			;-------
	move.b pcupy,d1	  ;pcu y = window y start?
	cmp.b scays+1,d1
	bls cu2		   ;yes: scroll one line down
			   ;no:
	subq.b #1,pcupy	  ;decrement pcu y
	bra activprm	  ;activate pr-mode
cu2
	bsr lindown		  ;line down
	bra activprm	  ;activate pr-mode
	
cleft			;pcu left:
			;---------
	move.b pcupx,d1	  ;pcu x = window x start?
	cmp.b scaxs+1,d1
	bls.s n53		   ;yes: skip
			   ;no:
	subq.b #1,pcupx	  ;decrement pcu x
	rts
n53
	bsr.s cup		  ;pcu up
	move.b scaxe+1,pcupx	  ;pcu x = window x end
	rts
	
cright			;pcu right:
			;----------
	move.b pcupx,d1	  ;pcu x = window x end?
	cmp.b scaxe+1,d1
	bhs.s n54		   ;yes: skip
			   ;no:
	addq.b #1,pcupx	  ;increment pcu x
	rts
n54
	bsr.s cdown		  ;pcu down
	move.b scaxs+1,pcupx	  ;pcu x = window x start
	rts

backspc			;back-space:
			;-----------
	bra.s cleft		  ;pcu left
	
	move.b #$11,d1	  ;get space-code
	bra pchar		  ;print char

quack	dc.b 0,0
fkey			;function-key:
			;-------------	

	lsr.b #3,d1
	bcc wait3

	lea.l 0,a1
	move.w #10,d5
	bsr prmonlin

	bra messend
wait2
	move.w c+$16,d0	;right mouse-button?
	btst #10,d0
	bne.s wait2
wait3
	lea.l 0,a1
	move.w #10,d5
	bsr prmonlin
	
messend			;message end:
			;------------
	tst.l (a7)+		  ;kick off return-addr
;	bra swcuon		  ;switch cursor on & leave
			;saved register
;	movem.l (a7)+,d0-d5/a1-a2
	rts
cywind				;COMPARE WINDOW Y START & END

	move.w scays,d0	;get window y start
	cmp.w scaye,d0	;compare with window y end
	rts

clrlin				;CLEAR LINE
;in: d0 = scrn-line

n121 	btst #14,c+$02	;blitter busy?
	bne.s n121		;yes: loop

	bsr gsclina		;get scrn-line addr
	move.l d0,c+$54	;set blit destination D

	move.w #$0100,c+$40	;blitcon0: set always 0
	clr.w c+$66		;clr modulo D
	clr.w c+$42		;blitcon1

			;set blit-size:
	move.w chsizey,d0	  ;get y line-length
	lsl.w #7,d0		  ;bitmap-lines into bits 7-15
	or.b scrnwidth+1,d0	  ;set size x (total scrn-width)
	lsr.w #1,d0		  ;/2
	
	move.w d0,c+$58	  ;start blitter
	rts

linup				;SCROLL ONE LINE UP

	bsr.s cywind	;window y start = end?
	beq.s n55		 ;yes: clr line
			 ;no:
	move.w scays,d0	;target-line = window-start y 
	move.w d0,d1
	swap d1
	
	addq.w #1,d0	;start-line = target-line +1
	move.w scaye,d1	;last-line = window-end y

	bsr.s copsclin	;copy scrn-lines
n55
	move.w scaye,d0	;get last line
	bra.s clrlin	;& clr line

lindown				;SCROLL ONE LINE DOWN

	bsr cywind		;window y start = end?
	beq.s n55		 ;yes: clr line
			 ;no:
	move.w scays,d0	;start-line = window-start y
	
	move.w d0,d1	;target-line = start-line +1
	addq.w #1,d1
	swap d1
	
	move.w scaye,d1	;last-line = window-end y -1
	subq.w #1,d1	

	bsr.s copsclin	;copy scrn-lines

	move.w scays,d0	;get start-line
	bra clrlin		;& clr line

copsclin				;COPY SCREEN-LINES
;in: d0 = (w) start-line
;in: d1 = (w) target-line/last-line

	movem.l d0-a6,-(a7)	;save registers

	move.l lintaba,a0	;get line-table addr

			;get number lines:
	move.w d1,d2	  ;last-line
	sub.b d0,d2		  ;- start-line = counter

			;set copy-direction:
	moveq #4,d4		  ;set ascending mode

	swap d1		  ;get target-line
	cmp.b d0,d1		  ;target-line <= start-line?
	bls.s n30b		   ;yes: skip
			   ;no: descending mode
	move.l d1,d0	  ;copy-start: = last-line
	swap d0
	moveq #-4,d4	  ;set descending mode
	add.b d2,d1		  ;target: + line-numbers
n30b
	asl.w #2,d0		;lines *4
	asl.w #2,d1
n31b			;copy line-addrs:
	move.l (a0,d0.w),d3	  ;get source
	move.l (a0,d1.w),(a0,d0.w) ;target into source
	move.l d3,(a0,d1.w)	  ;source into target
	
	add.l d4,a0		  ;modify addr-base
	dbra d2,n31b	  ;loop

	bsr sscrna		;set scrn-addrs in copper-list

	movem.l (a7)+,d0-a6	;get saved registers
	rts


copsclinr				;COPY SCREEN-LINES REAL
;in: d0 = (w) start-line
;in: d1 = (w) target-line/last-line

	bsr swcuoff		;switch cursor off
	
				;copy one plane:
				;---------------
n124 	btst #14,c+$02	;blitter busy?
	bne.s n124		;yes: loop
	
			;get number bitmap-lines:
	move.w d1,d2	  ;last-line
	sub.b d0,d2		  ;- start-line
	addq.b #1,d2	  ;+1
	mulu chsizey,d2	  ;* char-size y

			;set copy-direction:
	clr.l d3		  ;reset offs blit-addrs
	clr.w c+$42		  ;set ascending mode

	swap d1		  ;get target-line
	cmp.b d0,d1		  ;target-line <= start-line?
	bls.s n30		  ;yes: skip
			  ;no: descending mode:
	move.w d2,d3	    ;bitmap-lines
	mulu scrnwidth,d3	    ;* scrn-width
	subq.w #2,d3	    ;-2 = offs blit-addrs
	move.b #$02,c+$42+1	    ;set descending mode
n30
			;set blit-addresses:
	bsr.s gsclina	  ;get start-line addr
	add.l d3,d0		  ;+ offs blit-addrs
	move.l d0,c+$50	  ;set blit source A

	move.w d1,d0	  ;get target-line addr
	bsr.s gsclina
	add.l d3,d0		  ;+ offs blit-addrs	
	move.l d0,c+$54	  ;set blit destination D
	

	move.l #$ffffffff,c+$44	;set blit-masks A
	move.w #$09f0,c+$40	;set bltcon0
	clr.l c+$64		;reset modulo-values
	
			;set blit-size:
	lsl.w #7,d2		  ;bitmap-lines into bits 7-15
	or.b scrnwidth+1,d2	  ;set size x (total scrn-width)
	lsr.w #1,d2		  ;/2
	
	move.w d2,c+$58	  ;start blitter
	rts
	
gsclina				;GET SCREEN-LINE ADDR
;in: d0 = (b) scrn-line
;out: d0 = scrn-addr

	and.w #$ff,d0	;mask scrn-line
	asl.b #2,d0		;scrn-line *4 bytes
		
	move.l lintaba,a0	;get line-table addr

	move.l 0(a0,d0.w),d0	;get scrn-addr
	rts

gchpsca				;GET CHAR-POS SCRN-ADDR
;in: d0 = (w) line/column

	move.l d0,a0	;rescue d0
	mulu chsizex,d0	;char-size x * column
	
	exg a0,d0		;load line into d0.w:
	swap d0
	mulu chsizey,d0	;char-size y * line
	
	swap d0		;y-coord into hi-word
	move.w a0,d0	;x-coord into lo-word
			;get scrn-aaddr:

gscaddr				;GET SCREEN-ADDRESS
;in: d0 = (w) y/x coord
;out: a0 = scrn-addr
;out: d0 = bit-position (left-right ^ 0-15)

	move.w d0,-(a7)	;rescue x
	
	lea 0,a0		;clr a0
	lsr.w #3,d0		;x /8
	and.b #$fe,d0	;make even address
	move.w d0,a0	;x-byte screen to a0

	swap d0		;y into lo-word
	mulu scrnwidth,d0	;y * bytes/bitmap-line

	add.w d0,a0		;line-offs + x-offs
	add.l scrnaddr,a0	;+ scrn-offs 
	
	move.w (a7)+,d0	;get x
	and.l #$0f,d0	;isolate x-fine
	rts

except26				;INTERRUPT 2

				;KEYS-ROUTINE:

	move.b c1+$c00,rawkey	;rescue current raw-key

	move.b c1+$d00,ireqciaa	;rescue & reset i-requ. cia A (cia)

			;produce handshake:
	move.b #$51,c1+$e00	  ;sp out & force load
	move.b #$00,c1+$c00	  ;set shift-register

	movem.l d0-d2,-(a7)	;rescue registers
	move.l a0,-(a7)

	bsr wurkey		;work up raw-key

	move.l (a7)+,a0	;reload rescued registers
	movem.l (a7)+,d0-d2

n19
	btst.b #3,c1+$d00	;transmission handshake finished?
	beq.s n19		;no: loop

	clr.b c1+$e00	;sp in & timer stop
			  
	move.w #$0008,c+$9c	;reset i-request cia A (paula)
	rte
	
except27				;INTERRUPT 3

	btst #5,c+$1e+1	;vertical blank?
	beq.s n31		  ;no: skip
			  ;yes:
	move.w #$0020,c+$9c	;reset i-request vertical blank

	movem.l d0-d3,-(a7)	;rescue registers
	movem.l a0-a3,-(a7)
	
	bsr refinkey	;refresh inkey
	bsr cushine		;cursor-shining
	
	movem.l (a7)+,a0-a3	;reload rescued registers
	movem.l (a7)+,d0-d3

	rte
n31	
	move.w #$0070,c+$9c	;reset i-request
	rte

except28				;INTERRUPT 4

	eor.b #1,krk
	bne.s krk1

	move.w #$0001,c+$96	;audio-channel 0 off
	move.w #$0080,c+$9a	;audio-interrupt 0 disable
	clr.w c+$a8		;reset volume
	bne.s krk2
krk1
	move.w d0,-(a7)	;pause
	move.w #25,d0
krk3	dbra d0,krk3
	move.w (a7)+,d0
krk2
	move.w #$0080,c+$9c	;reset i-request audio-channel 0
	rte
	
krk	dc.b 0,0
	
refinkey				;REFRESH IN-KEY

	tst.b kdelayc	;keydelay-counter in repeat mode?
	bne.s n40		 ;no: skip
			 ;yes: 
	move.b curkey,inkey	;set inkey
	rts		;leave
n40
	subq.b #1,kdelayc	;decrement keydelay-counter
	rts		;leave
	
wurkey				;WORK UP RAW-KEY
			
	clr.l d0		;prepare d0
	
	move.b rawkey,d0	;any key changed?
	beq.s n34		;no: skip
			;yes: work out raw-key:
	clr.b rawkey	  ;reset rescued raw-key
	
	not.b d0		  ;get changed key
	lsr.b #1,d0	
	roxr.b #1,d1	  ;get key-direction
	
	cmp.b #$70,d0	  ;error code?
;	blo.s n32		  ;no: skip
			  ;yes: 
n32			  
	cmp.b #$60,d0	  ;level-key?
	blo.s n33		  ;no: skip
			  ;yes:
	and.b #$07,d0	    ;mask level-key (get 1 of 8 codes)
	bchg d0,levkey	    ;set current level-key
	bra.s n34		    ;leave
n33
			  ;decode char- & function-keys:
	move.b levkey,d2	    ;get level-keys
	and.b #$07,d2	    ;shift on?
	beq.s n35		    ;no: skip
			    ;yes:
	add.b #$60,d0	      ;mark rawkey as shifted
n35
	lea rkdect,a0	    ;addr rawkey-decode-table 
	add.l d0,a0		    ;+ rawkey code = decode-pointer
	move.b (a0),d0	    ;get fas-code (frenzie-amig.-stand.)

			  ;set new key-code:
	tst.b d1		    ;key up?
	bpl.s n36		    ;no: skip
			    ;yes:
	cmp.b curkey,d0	      ;current key = new key?
	bne.s n34		      ;no: ignore new key & leave
			      ;yes: 
	move.b #$80,curkey	        ;set no-information code
	bra.s n34		        ;leave
n36	
	move.b d0,curkey	    ;set current key
	move.b d0,inkey	    ;set inkey
	move.b kdelay,kdelayc	    ;reset keydelay-counter 
n34
	rts

cushine				;CURSOR-SHINING

	tst.b cushstat	;cursor on?
	bpl.s n34 		 ;no: leave
cushine2			 ;yes:
	subq.b #1,cushcount	;decrement cursor-shining counter
	bne.s n34		;time up? /no: leave
			  ;yes:
	move.b cushfreq,cushcount   ;reset cushining-counter
			    ;invert char on cu-pos

invcu				;INVERT CURSOR

	eor.b #$01,cushstat	;change optical cushining-status

	move.b cupy,d0	;get cu-pos y
	swap d0		;set line
	move.w #$0766,d0	;set blit-control 0	
	bsr spchlin2	;set pchar-line
	
	move.b cupx,d0	;get cu-pos x
	bsr spchx		;set pchar-column 

	bra pchar		;invert char	

swcuoff				;SWITCH CURSOR OFF

	and.b #$7f,cushstat	;switch cu-shining off 
	beq.s n201		;cu set? /no: leave
			 ;yes:
	move.l a0,-(a7)	;save registers
	movem.l d0-d1,-(a7)

	bsr invcu		;invert cu
	
	movem.l (a7)+,d0-d1	;get saved registers
	move.l (a7)+,a0
n201
	rts
	
swcuon				;SWITCH CURSOR ON

	move.b #1,cushcount	;release cushcount-underflow
	bset #7,cushstat	;switch cu-shining on
	bra cushine2

except00
	rte
	
linedit				;LINE-EDITOR
;in: d0 = (w) mask x-start/x-end
;in: d1 = (w) line/column

			;set cursor position:
	move.b d1,cupx	  ;set cu x
	swap d1		  ;get line
	move.b d1,cupy	  ;set cu y

	bsr swcuon		;switch cursor on
	
			;get text-pointer:

decodetxt				;DECODE TEXT
;in: a0 = text-pointer

	clr.w d0		;prepare d0
	lea decascii,a1	;get addr decode-ascii-table
nn2
	move.b (a0)+,d0	;get ascii-code
	beq.s nn1		;end? /yes: leave
	bmi.s nn2		;no ascii? /yes: next code
	cmp.b #$20,d0	;no ascii? 
	blo.s nn2		 ;yes: next code

	
	move.b -$20(a1,d0.w),-(a0)	;decode ascii
	addq.l #1,a0	;text-pointer +1
	bra.s nn2		;next code	
nn1
	rts

decascii				;decode-ascii-table
				;------------------
	dc.b $11,$17,$16,$0f,$0e,$10,$1e,$19
	dc.b $05,$06,$02,$00,$13,$01,$14,$03
	dc.b $36,$37,$38,$39,$3a,$3b,$3c,$3d
	dc.b $3e,$3f,$15,$12,$0c,$0b,$0d,$18
	dc.b $1d,$40,$41,$42,$43,$44,$45,$46
	dc.b $47,$48,$49,$4a,$4b,$4c,$4d,$4e
	dc.b $4f,$50,$51,$52,$53,$54,$55,$56
	dc.b $57,$58,$59,$07,$1b,$1d,$04,$20
	dc.b $1a,$60,$61,$62,$63,$64,$65,$66
	dc.b $67,$68,$69,$6a,$6b,$6c,$6d,$6e
	dc.b $6f,$70,$71,$72,$73,$74,$75,$76
	dc.b $77,$78,$79,$09,$1c,$0a,$21,$21

text				;TEXT

	dc.b "hello world!",$80
	dc.b 0		;end-marker


loadcharset				;LOAD CHARSET

	move.l #64*128,d0	;reserve chipmem
	bsr rchipm
	move.l d0,charbas	;save charset-base

	move.l d0,d5	;get dest-addr
	move.l #64*128,d6	;get quantity
	move.l #chsfile,d1	;load charset
	bra loadfil

loadmfmt				;LOAD MFM-TABLES

	move.l #20*256,d0	;reserve chipmem
	bsr rchipm
;	move.l d0,mfmcodet	;save charset-base

	move.l d0,d5	;get dest-addr
	move.l #11*256,d6	;get quantity
	move.l #mfmfile1,d1	;load charset
	bra loadfil

loadsample				;LOAD SAMPLE

	move.l #$2000,d0	;reserve chipmem
	bsr rchipm
	move.l d0,samplebase	;save sample-base

	move.l d0,d5	;get dest-addr
	move.l #$2000,d6	;get quantity
	move.l #samplefile,d1	;load sample
	bra loadfil

initcharset				;INIT CHARSET

	move.l #$00090008,d0	;set char-parameters
	move.l #$00080008,d1
	bsr setchpar
	bsr inchsctab	;init chars-scrn table
 
	clr.w scaxs		;set 1. window
	clr.w scays
	move.w charsx,d0
	subq.w #1,d0
 	move.w d0,scaxe
	move.w charsy,d0
	subq.w #1,d0
	move.w d0,scaye	

	move.b #5,d0	;set x-window
	move.b charsx+1,d4
	subq.b #5,d4
	bsr sscareax
	move.b #3,d0	;set y-window
	move.b charsy+1,d4
	subq.b #2,d4
	bra sscareay
	
chsfile			;charset-filename
	dc.b "df0:frebm",0
samplefile			;sample-file
	dc.b "df0:hitme",0	
mfmfile1			;mfm-code-table
	dc.b "df0:mfmcodet",0,0

crushchars				;CRUSH CHARSET

	move.l charbas,a1	;get char-base
	move.l #64*128,d0	;quantity
	jmp -210(a6) 	;free mem

crushsample				;CRUSH SAMPLE

	move.l samplebase,a1
	move.l #$2000,d0
	jmp -210(a6)
	
coltab				;COLOR-TABLE
	dc.w $0999,$0000,$0000,$066e
	
rkdect				;RAWKEYS-DECODE-TABLE
	
				;normal raw-keys:
	dc.b $1a,$37,$38,$39,$3a,$3b,$3c,$3d	;00
	dc.b $3e,$3f,$36,$5d,$19,$1b,$80,$36
	dc.b $50,$56,$44,$51,$53,$59,$54,$48	;10
	dc.b $4e,$4f,$5c,$00,$80,$37,$38,$39
	dc.b $40,$52,$43,$45,$46,$47,$49,$4a	;20
	dc.b $4b,$5b,$5a,$0f,$80,$3a,$3b,$3c
	dc.b $0c,$58,$57,$42,$55,$41,$4d,$4c	;30
	dc.b $13,$14,$01,$80,$14,$3d,$3e,$3f
	dc.b $11,$93,$94,$90,$90,$91,$92,$80	;40
	dc.b $80,$80,$01,$80,$95,$96,$98,$97
	dc.b $81,$82,$83,$84,$85,$86,$87,$88	;50
	dc.b $89,$8a,$07,$08,$03,$02,$00,$8b
				;shifted raw-keys:
	dc.b $21,$17,$16,$1f,$0e,$10,$1e,$03	;00
	dc.b $05,$06,$0b,$18,$1a,$1c,$80,$80
	dc.b $70,$76,$64,$71,$73,$79,$74,$68	;10
	dc.b $6e,$6f,$7c,$02,$80,$80,$80,$80
	dc.b $60,$72,$63,$65,$66,$67,$69,$6a	;20
	dc.b $6b,$7b,$7a,$04,$80,$80,$80,$80
	dc.b $0d,$78,$77,$62,$75,$61,$6d,$6c	;30
	dc.b $12,$15,$20,$80,$80,$80,$80,$80
	dc.b $11,$b3,$b4,$b0,$b0,$b1,$b2,$80	;40
	dc.b $80,$80,$80,$80,$b5,$b6,$b8,$b7
	dc.b $a1,$a2,$a3,$a4,$a5,$a6,$a7,$a8	;50
	dc.b $a9,$aa,$09,$0a,$80,$80,$80,$ab				 


			;SAVED REGISTER FOR KICKSTART

gname	dc.b "graphics.library",0

sciaatal	dc.b 0		;cia A timer A lo
sciaatah	dc.b 0		;cia A timer A hi
sciaaca	dc.b 0		;cia A control-register A	
cmbase	dc.l 0		;chip-mem base
istat	dc.w 0		;i-register


				;AUDIO VARIABLES

samplebase	dc.l $70000		;sample-base
				
			
				;KEYS VARIABLES
				
ireqciaa	dc.b 0		;i-request register cia A
	dc.b 0
rawkey	dc.b 0		;current raw-key 
curkey	dc.b 0		;current key
levkey	dc.b 0		;current level-keys
inkey	dc.b $80		;ready key-code for getkey-routine

kdelay	dc.b 15		;key-delay
kdelayc	dc.b 0		;keydelay-counter

				
				;CURSOR VARIABLES

cushstat	dc.b $80		;cu-shining status
cushcount	dc.b 1		;cu-shining counter
cushfreq	dc.b 15		;cu-shining frequency
	dc.b 0

cupx	dc.b 10		;cu-position x
cupy	dc.b 10		;cu-position y


				;SCREEN-PARAMETERS
				
scrnaddr	dc.l 0		;addr screen 1
sczei2	dc.l 0		;addr screen 2

ssccp			;addr: special screen-chars parameters
scrnwidth	dc.w 88		;scrn-width (bytes)
scrnlines	dc.w 280		;number of scrn-lines

sscc	dc.w 3		;special scrn-char const. (x)
	dc.w 0				 ;(y)

charssc	dc.w 0		;number of chars/screen


				;CHAR-PARAMETERS
ccbmbas	dc.l 0
charbas	dc.l 0		;char-base addr
coltaba	dc.l 0		;column-table addr
lintaba	dc.l 0		;line-table addr
cstabqu	dc.l 0		;chars-scrn table quantity (free mem!)

charsx	dc.w 0		;number of chars/line
charsy	dc.w 0		;number of chars/column
chfinepx	dc.w 0		;chars fine-position x
chfinepy	dc.w 0		;chars fine-position y

chsizex	dc.w 0		;char-size x
chsizey	dc.w 0		;char-size y
	
tchmask	dc.l 0		;total char-mask (^ char-size y)
charmask	dc.w 0		;char-mask (^ char-width)
chbmods	dc.w 0		;blitter modulo source A
chbmodd	dc.w 0		;blitter modulo destination D
chbsize	dc.w 0		;blitter size


				;PCHAR VARIABLES
				
csclina	dc.l 0		;current scrn-line addr
bltcon0	dc.w 0		;blit-control 0

pcupx	dc.b 10		;print-cursor position x
pcupy	dc.b 10		;print-cursor position y
pmode	dc.b 0		;print-mode
	dc.b 0

bltopmod	dc.b $ff,0		;blitter-operation mode


				;WINDOWS VARIABLES
	
scaxs	dc.w 0		;scrn-area x start
scays	dc.w 0		;scrn-area y start
scaxe	dc.w 0		;scrn-area x end
scaye	dc.w 0		;scrn-area y end


exctab				;EXCEPTIONS-TABLE

	dc.l except00
	dc.l except00
	dc.l except00
	dc.l except00
	dc.l except00
	dc.l except00
	dc.l except00
	dc.l except00
	dc.l except00
	dc.l except00 

	dc.l except00
	dc.l except00
	dc.l except00
	dc.l except00
	dc.l except00
	dc.l except00
	dc.l except00
	dc.l except00
	dc.l except00
	dc.l except00

	dc.l except00
	dc.l except00
	dc.l except00
	dc.l except00
	dc.l except00
	dc.l except00
	dc.l except26
	dc.l except27
	dc.l except28
	dc.l except00

	dc.l except00
	dc.l except00
	dc.l except00
	dc.l except00
	dc.l except00
	dc.l except00
	dc.l except00
	dc.l except00
	dc.l except00
	dc.l except00

	dc.l except00
	dc.l except00
	dc.l except00
	dc.l except00
	dc.l except00
	dc.l except00
	dc.l except00
	dc.l except00

	
;CHIP-MEM
;********

cms			;chip-mem start

clrchbm				;CLEAR-CHAR BLITTER-MASK

	dc.w $f000,0,$f000,0,$f000,0,$f000,0
	dc.w $f000,0,$f000,0,$f000,0,$f000,0
	dc.w $f000,0,$f000,0,$f000,0,$f000,0
	dc.w $f000,0,$f000,0,$f000,0,$f000,0


clist				;COPPER-LIST

			;bit-planes:
waitlin	dc.w $f,$fffe	  ;wait line
	dc.w $e0
sczeih1	dc.w $0		  ;scrn-addr 1 hi
	dc.w $e2
sczeil1	dc.w $0		  ;scrn-addr 1 lo

	dc.l 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
	dc.l 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
	dc.l 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
	dc.l 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
	dc.l 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
	dc.l 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0

cme 			;chip-mem end


; DOS FILING SYSTEM
;------------------

initdosfil				;INIT DOS FILING SYSTEM

	move.l $4,a6	;kernel-base
	bra opendos		;open dos-lib

opendos				;OPEN DOS-LIBRARY

	lea doslib,a1
	jsr -408(a6)

	move.l d0,dosbas
	rts

doslib	dc.b "dos.library",0
dosbas	dc.l 0	

	
loadfil				;LOAD FILE
;in: d1 = addr file-name
;in: d5 = dest-addr
;in: d6 = quantity

	bsr openfil		;open file
	beq.s nn10		;error? /yes: leave
	
	move.l d5,d2	;set dest-addr
	move.l d6,d3	;set quantity
	jsr -42(a6)		;read from file
	bra closefil
nn10
	btst #6,c1		;right mouse-button?
	bne nn10

	bra closefil	;close file

openfil				;OPEN FILE
;in: d1 = addr file-name
;out: d1 = datei-identification
;out: z-flag = 1 ^ error

	move.l #1005,d2	;set mode
	move.l dosbas,a6	;open file
	jsr -30(a6)
	move.l d0,d1	;datei-ident into d0
	move.l d0,datident	;& save
	rts

datident			;datei-identification
	dc.l 0

closefil				;CLOSE FILE

	move.l datident,d1	;get datei-ident
	jsr -36(a6)		;close file

	move.l $4,a6	;load kernel-base
	rts

savefil				;SAVE FILE
;in: d0 = addr file-name
;out: d0 = dest-addr
	rts
	move.l d0,a6
	jsr -150(a6)
	
	move.l $4,a6
	rts

	
; SCREEN-OPTIONS
;----------------

prmonlin				;PRINT MONITOR-LINES
;in: a1 = source-addr
;in: d5 = quantity lines

s1
	bsr activprm	;activate pr-mode
	
	move.l a1,d1	;get addr
	bsr.s prhexl	;print addr
	
	move.b #$15,d1	;get ":"
	bsr pchar	;print char

	move.w #7,d6	;counter: 16 bytes

s2	
	move.b #$11,d1	;get ´space´
	bsr pchar		;print char

	move.b (a1)+,d1	;get mem-byte
	bsr.s prhexb	;print hex-byte
	
	dbra d6,s2		;next byte

	bsr ret		;return
	dbra d5,s1		;next line

	rts


prhexl				;PRINT HEX-LONGWORD
;in: d1 = l-word

	move.w d1,-(a7)	;save lo-word
	
	swap d1		;get hi-word
	bsr.s prhexw	;print word
	
	move.w (a7)+,d1	;get saved lo-word
			;print word:

prhexw				;PRINT HEX-WORD
;in: d1 = word

	move.w d1,-(a7)	;save word
	
	lsr.w #8,d1		;get hi-byte
	bsr.s prhexb	;print byte
	
	move.w (a7)+,d1	;get saved word
	and.w #$00ff,d1	;get lo-byte
			;print byte:

prhexb				;PRINT HEX-BYTE
;in: d1 = byte

	move.w d1,-(a7)	;save byte
	
	lsr.b #4,d1		;get hi-nibble
	add.b #$36,d1	;get print-code
	bsr pchar		;print char
	
	move.w (a7)+,d1	;get saved byte
	and.b #$0f,d1	;get lo-nibble
	add.b #$36,d1	;get print-code
	bra pchar		;print char


LINE_ED				;LINE-EDITOR
;in: a2 = text-memory
;in: d2.w = quantity chars
;in: d3.w = cursor-position
;in: d4.w = input-x
;in: d5.w = input-line

;init:
;-----
			;check bound
	cmp.w #2,d2
	blo 7$
			;install text-memory
	clr.w d0
3$	
	tst.b (a2,d0.w)
	bmi.s 4$		;end-marker?
	addq.w #1,d0
	cmp.w d0,d2
	bne.s 3$
	subq.w #1,d0
4$
	move.b #$80,(a2,d0.w)
	addq.w #1,d0
	cmp.w d0,d2
	bne.s 4$
			;print text
	bsr led_setcu
	move.l a2,a1
	bsr led_ptext
	bsr led_setcu
	bsr swcuon

1$
	bsr getkey
	tst.b d0
	bmi.s 5$		  

			;key is char
				;test on "text full"
	tst.b -2(a2,d2.w)
	bpl.s 1$
				;copy text
	move.w d2,d1
	subq.w #2,d1
	sub.w d3,d1
	lea.l -2(a2,d2.w),a1
	bra.s 2$
6$
	move.b -(a1),1(a1)
2$	dbra d1,6$
				;set char
	move.b d0,(a1)
				;print text
	bsr led_ptext
	addq.w #1,d3
	bsr led_setcu
	bsr swcuon
	bra 1$
5$
			;key is no char
	cmp.b #$90,d0		;return?
	beq.s 7$
	cmp.b #$91,d0		;esc?
	beq.s 14$
	cmp.b #$92,d0		;delete?
	beq.s 12$
	cmp.b #$93,d0		;back-space?
	beq.s 8$
	cmp.b #$97,d0
	beq.s 11$		;cursor-move?
	cmp.b #$98,d0
	beq.s 11$
	bra.s 1$
14$			;escape
	bsr esc
	bra 1$

7$			;end
	bra swcuoff
				;registers
	rts
8$			;back-space
				;test on underflow
	tst.w d3
	beq 1$
				;copy text
	move.w d2,d1
	sub.w d3,d1
	lea.l -1(a2,d3.w),a1
	bra.s 10$
9$
	move.b 1(a1),(a1)+
10$	dbra d1,9$
				;print text
	bsr swcuoff
	subq.w #1,d3
	lea.l (a2,d3.w),a1
	bsr led_setcu
	bsr led_ptext
	bsr led_setcu
	bsr swcuon
	bra 1$

11$			;cursor-movement
	bsr swcuoff
	and.w #$0001,d0
	asl.b #1,d0
	subq.w #1,d0
	sub.w d0,d3
	bsr led_setcu
	bsr swcuon
	bra 1$
12$			;delete
				;check bound
	cmp.b #$80,(a2,d3.w)
	beq 1$
	addq.w #1,d3
	bra 8$

led_setcu
			;check bounds
1$	tst.w d3
	bmi.s 3$
	cmp.b #$80,-1(a2,d3.w)
	bne.s 2$
	dbra d3,1$
3$
	clr.w d3
2$			;set pos
	move.w d3,d0
	add.w scaxs,d0
	add.w d4,d0
	move.b d0,pcupx
	move.b d0,cupx
	move.w d5,d0
	add.w scays,d0
	move.b d0,pcupy
	move.b d0,cupy
	rts

led_ptext
	bsr ptext
	lea.l 1$,a1
	bra ptext
1$	dc.l $0d118080



; BOOL´S LOGIC
;--------------

Elemination

Add_Term
;a1,from: addr
;d1,from: length
;a2,to: addr
;d2,to: length
;_a2
;_d2,to: new length

	move.l a1,a0
	lea.l (a2,d2),a1
	add.l d1,d2
	lsr.l #1,d1
	bra.s 1$
2$
	move.w (a0)+,(a1)+
1$	subq.l #1,d1
	bpl.s 2$
	rts

Calc_Term
;a1,term: addr
;d3,term: length
;a2,values-table: addr
;_d1.b,result

	lsr.l #1,d3
	clr.b d1
3$			;check on end
	subq.l #1,d3
	bmi.s 2$

	move.w (a1)+,d0
	bmi.s 1$
			;mal
	tst.b d1		;last was 0?
	beq.s 3$
	bne.s 5$

1$			;plus
	tst.b d1		;last product was 1?
	bne.s 2$

5$			;calc current value
	and.w #$7fff,d0
	lsr.w #1,d0
	scc d2
	move.b (a2,d0.w),d1
	eor.b d2,d1
	and.b #$01,d1
	bra.s 3$

2$			;leave
	rts

Set_Values_Table


Code_Text
;a0,text-addr
;a1,table_addr
;a2,term output: addr
;d0.w,text-length
;d2.w,flag of term
;_a1,term output: addr
;_d1,term-length
			;prepare flag
	tst.b d2
	beq.s 5$
	move.w #$8001,d2
5$	eor.w #$8001,d2
			;some inits
	movem.l d0/a2,-(a7)
	clr.w d3
	eor.w d2,d3
	bra.s 4$
2$			;mask char
	move.b (a0)+,d1
	bmi.s 3$
	cmp.b #$40,d1
	blo.s 3$
	addq.b #1,d1
	and.b #$1f,d1
	cmp.b #27,d1
	blo.s 6$
3$	clr.b d1
6$	move.w #4,d4
1$			;set bit in table
	move.b d1,(a1)
	and.b #1,(a1)+
			;make term
	lsr.w #1,d3
	lsr.b #1,d1
	roxl.w #1,d3
	eor.b d2,d3
	move.w d3,(a2)+
			;next
	addq.w #2,d3
	dbra d4,1$
4$	dbra d0,2$

	movem.l (a7)+,d1/a1
	bset #7,(a1)
	mulu #5*2,d1
	rts

Add_Predicate
;a0,text-addr
;d0.w,text-length
;d2.w,flag of term
;_d7.b,computer´s advise

	lea.l values_table,a1
	lea.l term_puffer,a2
	bsr Code_Text

	bsr What_Says_Comp

	move.l Main_Term_Addr,a2
	move.l Main_Term_Length,d2
	bsr Add_Term
	move.l d2,Main_Term_Length
	rts

What_Says_Comp
;d7.b,result

	movem.l d0-d6/a0-a6,-(a7)

	move.l Main_Term_Addr,a1
	move.l Main_Term_Length,d3
	move.l #values_table,a2
	bsr Calc_Term
	move.b d1,d7

	movem.l (a7)+,d0-d6/a0-a6
	rts


term_puffer
	ds.w pred_txt_leng*5+10
values_table
	ds.b pred_txt_leng*5+10

Main_Term_Addr
	dc.l 0
Main_Term_Length
	dc.l 0


Search_String
****************************
*  search string in table  *
****************************
;a0,addr of compare-string
;a1,addr of first string in table
;d0.w,length -1 of compare-string in words
;_ZF=0 <==> string not found
;_d1,counted string-position (0=first string)
;_d1,string not found ==> position of last string +1
;_a1,addr of current string -4 ("-4": addr of next string!)

	movem.l d0/d2-d4/a0,-(a7)
	moveq #0,d1		;reset counter of string-position
	move.l a0,d2		;save addr of compare-string
	bra.s 3$
1$
	addq.l #1,d1		;inc counter of string-position
	tst.l d4		;last string?
	beq.s 4$		;=yes
	move.l d4,a1		;get string-addr (string of table)
	move.l d2,a0		;reset addr of compare-string
3$	move.l -4(a1),d4	;save addr of next string of table
	move.w d0,d3		;reset string-length-counter
2$	cmp.w (a0)+,(a1)+
	dbne d3,2$		;equal ==> compare next word
	bne.s 1$		;all words identified?
	beq.s 5$		;=yes
4$
	moveq #1,d4		;set ZF:=0 (string not found)
5$	move.l d4,a1		;get addr of current string
	movem.l (a7)+,d0/d2-d4/a0
	rts

Search_String_and_Add
**************************************************************
*  search string in table and implement string if not found  *
**************************************************************
;a0,addr of compare-string
;a1,addr of first string in table
;d0.w,length -1 of compare-string in words
;_ZF=0 <==> string was not in table
;_d1,counted string-position (0=first string)
;_a1,addr of current string -4 ("-4": addr of next string!)

	bsr Search_String	;search string
	beq.s 1$		;string found? =yes
	
	movem.l d0/d2/a0/a2,-(a7)
	move.l a0,a2		;save addr of compare-string
	move.w d0,d2		;save string-length

	asl.w #1,d0		;block-quant:= (d0+1)*2+2
	addq.w #4,d0
	ext.l d0
	bsr Alloc_Mem		;alloc mem for new block
	clr.l (a0)		;set "last string"-mark
	addq.l #4,a0		;get addr of new string
	move.l a0,(a1)		;set addr of new string into table
	lea.l -4(a0),a1		;save addr of current string

2$	move.w (a2)+,(a0)+	;copy compare-string into table
	dbra d2,2$

	tst.b d2		;set ZF:=0 (string was not in table)
	movem.l (a7)+,d0/d2/a0/a2
1$	rts

Delete_String
****************************
*  delete string in table  *
****************************
;{Search_String}

	bsr Search_String	;search string
	bne.s 1$		;string not found? =yes
	move.b #$80,4(a1)	;set "string is empty"-mark
1$	rts

Analyse_String
**************************************************************
*  divide string into names, numbers and special characters  *
**************************************************************
;a1,string-addr (bytes: >$7f =end)
;_a2,table-addr
;_Block-Structure: 
;  {addr of next block: 0=last block}.l
;  {length of string}.w
;  {type of string: 0= special character, 1= name, 2= number}.w
;  {string}

	movem.l d0-d2/a0-a1/a3,-(a7)
	lea 9$(pc),a2		;current block is imaginary block
8$				;--- get string ---
	clr.w d1		;set "current type of string is insecure"
	clr.w d0		;reset length-counter
5$				;--- get char of string ---
	move.b (a1)+,d0		;get byte
	bmi.s 1$		;string-end? =yes
	addq.w #1,d2		;inc length-counter
	tst.w d1		;current type of string is insecure?
	beq.s 2$		;=yes
				;--- current string is name or number ---
	cmp.b #char__,d0	;char is "_"?
	beq.s 5$		;=yes
	cmp.b #$40-10,d0	;char is letter or digit?
	bhs.s 5$		;=yes
	subq.l #1,a1		;dec addr of input-string
	subq.w #1,d2		;dec length-counter
13$	bsr.s 4$		;add string to table
	bra.s 8$		;next string
2$				;--- current type of string is insecure ---
	cmp.b #$40,d0		;char is letter?
	blo.s 10$		;=no
11$	moveq #1,d1		;set "current string is name"
	bra.s 5$		;next char
10$	cmp.b #char__,d0	;char is "_"?
	beq.s 11$		;=yes
	cmp.b #$40-10,d0	;char is digit?
	blo.s 12$		;=no
	moveq #2,d1		;set "current string is number"
	bra.s 5$		;next char
12$	cmp.b #char_space,d0	;char is space?
	beq.s 8$		;=yes
	bne.s 13$		;current string is special char
4$				;--- add string to table ---
	move.w d2,d0		;block-length:= length-counter +8
	addq.w #8,d0
	bsr Alloc_Mem		;alloc mem for block
	move.l a0,(a2)		;set new block-addr in old block
	move.l a0,a2		;save new block-addr
	addq.w #4,a0		;skip "addr of next block"
	move.w d2,(a0)+		;set string-length in block
	move.w d1,(a0)+		;set string-type in block
	move.l a1,a3		;save addr of input-string
	neg.w d2		;copy current string into block
7$	move.b (a3,d2.w),(a0)+
	addq.w #1,d2
	bne.s 7$
	rts
1$				;--- end of input-string ---
	tst.w d1		;current string is name or number?
	beq.s 14$		;=no
	subq.w #1,d2		;dec length-counter
	bsr.s 4$		;add string to table
14$	move.l 9$(pc),a2	;get table-addr
	movem.l (a7)+,d0-d2/a0-a1/a3
	rts

9$	dc.l 0			;imaginary block




;--------------------------------------------------------;
;  REMARK!: list-offsets are signed and can exceed list  ;
;--------------------------------------------------------;

Size_Ring_Entry	= 10
Flags_Entry	= 8

Take_Off_Ring
***************************************
*  take entered ring off server-ring  *
***************************************
;d0,ring-identification
;a0,server-ring
;_NF,1 <==> ring not found

	move.l a0,-(a7)
	bsr Search_Ring		;search ring in server-ring
	bmi.s 1$		;not found? =yes
	subq.l #8,a0		;get list of entry
	bsr Delete_List		;delete list of entry
	and #$ff-8,ccr		;set flag: ok
1$	move.l (a7)+,a0
	rts

Enter_Ring
*******************************
*  enter ring in server-ring  *
*******************************
;d1,ring-identification
;a1,server-ring
;a2,ring

	movem.l d0/a0,-(a7)
	moveq #Size_Ring_Entry,d0 ;get size of ring-entry
	bsr Add_New_List	;add list for entry to server-ring	
	addq.l #8,a0		;get block-addr of list
	move.l d1,(a0)+		;set ring-identification
	move.l a2,(a0)+		;set ring
	clr.w (a0)		;reset flags of ring
	movem.l (a0)+,d0/a0
	rts

Close_Ring
************************
*  close entered ring  *
************************
;d0,ring-identification
;a0,server-ring
;_a0,ring
;_NF,1 <==> ring not found
;_ZF,1 <==> ring was closed

	bsr Search_Ring		;search ring in server-ring
	bmi.s 1$		;ring not found? =yes
	bclr #0,Flags_Entry(a0)	;set "ring closed"-flag
	move.l 4(a0),a0		;get ring
1$	rts	

Open_Ring
***********************
*  open entered ring  *
***********************
;d0,ring-identification
;a0,server-ring
;_a0,ring
;_NF,1 <==> ring not found
;_ZF,1 <==> ring was closed

	bsr Search_Ring		;search ring in server-ring
	bmi.s 1$		;ring not found? =yes
	bset #0,Flags_Entry(a0)	;set "ring open"-flag
	move.l 4(a0),a0		;get ring
1$	rts	

Search_Ring_2	;;;(Not Used!)
*************************
*  search entered ring  *
*************************
;d0,ring-identification
;a0,server-ring
;_a0,addr of entry of identified ring in server ring
;_NF,1 <==> ring not found

	movem.l d1-d2,-(a7)
	move.l a0,d2		;save start of server-ring
4$	move.l 4(a0),d1		;get block-size of list
2$	sub.l #Size_Ring_Entry,d1 ;block-size - length of one entry
	bmi.s 1$		;no further entries in block? =yes
	cmp.l 8(a0,d1),d0	;ring identified?
	bne.s 2$		;=no
	lea.l 8(a0,d1),a0	;get addr of entry of found ring
	bra.s 3$		;end
1$	move.l (a0),a0		;get next list of server-ring
	cmp.l a0,d2		;ring not found? (server-ring checked)
	bne.s 4$		;=no
	or #$08,ccr		;set flag "ring not found"
3$	movem.l (a7)+,d1-d2
	rts

Search_Ring
*************************
*  search entered ring  *
*************************
;d0,ring-identification
;a0,server-ring
;_a0,addr of entry of identified ring in server ring (= block-start)
;_NF,1 <==> ring not found

	movem.l d2,-(a7)
	move.l a0,d2		;save start of server-ring
4$	cmp.l 8(a0),d0		;ring identified?
	beq.s 3$		;=yes
	move.l (a0),a0		;get next list of server-ring
	cmp.l a0,d2		;ring not found? (server-ring checked)
	bne.s 4$		;=no
	or #$08,ccr		;set flag "ring not found"
3$	addq.l #8,a0		;get addr of entry of found ring
	movem.l (a7)+,d1
	rts


Search_List
************************************
*  search entire list within ring  *
************************************
;a0,list
;a1,ring
;d2,end-list of ring (will not be compared)
;_d0,counted list within ring (0 = first list of ring)
;_a2,found list in ring
;_ZF,1 <==> list not found

	movem.l d1/a1/a3,-(a7)
	clr.l d0		;reset counter of ring-list
	move.l 4(a0),d1		;get size of list-block
2$	cmp.l 4(a1),d1		;size list-block = size ring list-block?
	bne.s 1$		;=no
	move.l a1,a2		;get current ring-list
	addq.l #8,a2		;get block-addr of ring-list
	move.l 8(a0),a3		;get block-addr of list
	bra.s 4$		;start block-comparison
3$	cmp.b (a3)+,(a2)+	;compare block-bytes
	bne.s 5$		;bytes are equal? =no
4$	subq.l #1,d1		;dec block-size
	bpl.s 3$		;complete block compared? =no
	bra.s 6$		;list found
5$	move.l 4(a0),d1		;get size of list-block
1$	addq.l #1,d0		;inc counter of ring-list
	move.l (a1),a1		;get next list of ring
	cmp.l a1,d2		;all lists of ring checked?
	bne.s 2$		;=no
6$	move.l a1,a2		;get current ring-list
	movem.l (a7)+,d1/a1/a3
	rts

Delete_Ring_Block
**************************
*  delete block of ring  *
**************************
;a1,list
;d1,list-offset
;d0,block-size (do not use 0)
;_a1,list after deleted block

	move.l a0,-(a7)
	bsr Remove_Ring_Block	;remove block of ring
	bsr Delete_Ring		;delete removed ring
	move.l (a7)+,a0
	rts

Remove_Ring_Block
***************************************************
*  remove block from ring and link block to ring  *
***************************************************
;a1,list
;d1,list-offset
;d0,block-size (do not use 0)
;_a0,first list of block
;_a1,list after block before removing

	bsr Split_Ring_Block	;split block into lists
	bra Remove_Ring		;remove ring (=block)

Alloc_Ring_Block
********************************
*  allocate block within ring  *
********************************
;a1,ring: list
;d1,ring: list-offset
;d0,block-size
;_a1,list of block (next list = list at set position)
;_order: block - ring:set position - ring:end

	movem.l d2/a0/a2,-(a7)
	bsr Install_List	;install list for block
	move.l a0,a2		;ring2 is installed list
	clr.l d2
	bsr Add_Ring_Pos	;add block (=ring2) to ring
	move.l a2,a1		;get list of block
	movem.l (a7)+,d2/a0/a2
	rts

Add_Ring_Pos
**************************************
*  add ring to ring at any position  *
**************************************
;a1,ring1: list
;d1,ring1: list-offset
;a2,ring2: list
;d2,ring2: list-offset
;_a1,ring1: list at set position
;_a2,ring2: list at set position
;_order: ring1:set position - ring1:end - ring2:set position - ring2:end

	movem.l d1-d2/a0,-(a7)
	clr.l d0		;block-size:= 0
	bsr Split_Ring_Block	;split ring1 at set position
	move.l a2,a1		;prepare "split ring2"
	move.l d2,d1
	move.l a0,d2		;save position in ring1
	bsr Split_Ring_Block	;split ring2 at set position
	move.l d2,a1		;get ring1
	bsr Add_Ring		;add ring
	move.l a0,a2		;get ring2
	movem.l (a7)+,d1-d2/a0
	rts

Delete_Ring
************************
*  delete entire ring  *
************************
;a0,ring

	move.l a1,-(a7)
	move.l a0,a1		;save first list
1$	bsr Delete_List		;delete list
	cmp.l a0,a1		;end-list reached
	bne.s 1$		;=no
	move.l (a7)+,a1
	rts

Remove_Ring
***************************
*  remove ring from ring  *
***************************
;a0,ring: list
;a1,ring: end-list (not part of the list)
* nonsense (empty list <==> entire list) has no effect *

	movem.l a2-a3,-(a7)
	move.l -4(a0),a2	;save list before block
	move.l -(a1),a3		;save last list of block
	move.l a2,(a1)+		;link list before block and end-list
	move.l a1,(a2)
	move.l a3,(a0)		;link first list and last list of block
	move.l a0,-(a3)
	movem.l (a7)+,a2-a3
	rts

Add_Ring
**********************
*  add ring to ring  *
**********************
;a0,ring1: list
;a1,ring2: list
;_order: ring1:list - ring1:last list - ring2:list - ring2:last list

	movem.l a2-a3,-(a7)
	move.l -(a0),a2		;save ring1:last list
	move.l -(a1),a3		;save ring2:last list
	move.l a2,(a1)+		;link ring1:last list and ring2:list
	move.l a1,(a2)
	move.l a3,(a0)+		;link ring2:last list and ring1:list
	move.l a0,(a3)
	movem.l (a7)+,a2-a3
	rts

Split_Ring_Block
************************************
*  split block of ring into lists  *
************************************
;a1,list
;d1,list-offset
;d0,block-size (routine will work faster if 0)
;_a0,first list of block
;_a1,list after block (provided that block-size is not 0)

	movem.l d1/a2,-(a7)
	bsr Legal_List_Offset	;legalize list-offset
	move.l a1,a0		;save list in case new offs = 0
	beq.s 1$		;new offset = 0? =yes
	move.l a1,a2		;split list
	bsr Split_List
	move.l (a2),a0		;save start-list
1$	tst.l d0		;block-size = 0?
	beq.s 2$		;=yes
	add.l d0,d1		;add block-size to block-start
	bsr Legal_List_Offset	;legalize list-offset
	beq.s 2$		;new offset = 0? =yes
	move.l a1,a2		;split list
	bsr Split_List
	move.l (a2),a1		;get end-list
2$	movem.l (a7)+,d1/a2
	rts

Legal_List_Offset
*************************************
*  legalize offset-pointer of list  *
*************************************
;a1,list
;d1,list-offset = delta (exceeds list)
;_a1,new list
;_d1,new list-offset (within list)
;_ZF,1 <==> list-offset = 0

	tst.l d1
	bpl.s 1$		;delta < 0? =no
				;--- delta < 0 ---
7$	move.l -(a1),a1		;get previous list
	add.l 4(a1),d1		;delta + current block-size
	bmi.s 7$		;overflow? =no
	rts
				;--- delta >= 0 ---
3$	move.l (a1),a1		;get next list
1$	sub.l 4(a1),d1		;delta - current block-size
	bpl.s 3$		;underflow? =no
	add.l 4(a1),d1		;get last delta
	rts

Delete_List
*****************************************
*  delete list and link adjacent lists  *
*****************************************
;a0,list
;_a0,next list of deleted list

	movem.l d0/a1,-(a7)
	bsr Remove_List		;remove list
	move.l 4(a0),d0		;get block-size of list
	add.l #12,d0		;get list-size
	subq.l #4,a0		;get list-start
	bsr Free_Mem		;free mem of list
	move.l a1,a0		;get next list
	movem.l (a7)+,d0/a1
	rts

Remove_List
*****************************************
*  remove list and link adjacent lists  *
*****************************************
;a0,list
;_a0,list
;_a1,next list of removed list

	move.l -4(a0),a1	;get previous list
	move.l (a0),(a1)	;set addr of next list in previous list
	move.l (a0),a1		;get next list
	move.l -4(a0),-4(a1)	;set addr of previous list in next list
	rts

Add_New_List
**********************************
*  install list and add to list  *
**********************************
;a1,list
;d0,block-size of new list
;_a0,new list
;_order: list - new list - ...

	movem.l a1-a2,-(a7)
	bsr Install_List	;install new list
	move.l a1,a2		;list is main-list
	move.l a0,a1		;new list is insert-list
	bsr Add_List		;add new list to main-list
	movem.l (a7)+,a1-a2
	rts

Add_List
*******************************
*  add list to list and link  *
*******************************
;a2,main-list
;a1,list, that should be added (insert-list)
;_order: main-list - insert-list - ...

	move.l a0,-(a7)
	move.l (a2),a0		;save upper-list
	move.l a2,-4(a1)	;set addr of lower list in insert-list
	move.l a1,(a2)		;set addr of insert-list in lower-list
	move.l a0,(a1)		;set addr of upper list in insert-list
	move.l a1,-(a0)		;set addr of insert-list in upper-list
1$	move.l (a7)+,a0
	rts

Insert_List
****************************************
*  insert list within a list and link  *
****************************************
;a2,main-list
;a1,list, that should be inserted (insert-list)
;d1,offset in main-list

	bsr Split_List		;split main-list
	bra Add_List		;add insert-list to lower list

Split_List
****************************************
*  split list into two lists and link  *
****************************************
;a2,list
;d1,size of lower list for splitting
;_a2,lower list

	movem.l d0/d2/a0-a1,-(a7)
	move.l (a2)+,d2		;get next list
;;;;;	move.l (a2),d0		;get list-size
;;;;;	lsr.l #1,d0		;halve list-size
;;;;;	cmp.l d1,d0		;find out bigger part of splitted list
;;;;;	bhs.s 1$		;upper part is bigger? =yes
				;--- lower part is bigger ---
	move.l (a2),d0		;get list-size
	sub.l d1,d0		;get size of upper part
	lea.l 4(a2,d1),a0	;get addr of upper part
	bsr Install_List_Set	;install list of upper part
	bsr Free_Mem		;free mem of upper part
	move.l d1,(a2)		;set size of lower part in lower list
	move.l a1,-(a2)		;set addr of upper list in lower list
	move.l d2,(a1)		;set addr of saved next list in upper list
	move.l a2,-(a1)		;set addr of lower list in upper list
2$	movem.l (a7)+,d0/d2/a0-a1
	rts
1$				;--- upper part is bigger ---

Install_List_Set
**********************************
*  install a list and set block  *
**********************************
;a0,block-addr
;d0,block-size
;_a1,list

	move.l a0,-(a7)
	bsr Install_List	;install list
	lea.l 8(a0),a1		;get block-addr of list
	move.l (a7)+,a0		;get block-addr
	bsr Copy_Mem		;copy block into list
	subq.l #8,a1		;get list
	rts

Install_List
******************
*  install list  *
******************
;d0,block-size of list
;_a0,list

	add.l #12,d0		;get list-size
	bsr Alloc_Mem		;alloc mem for list
	sub.l #12,d0		;get block-size
	move.l a0,-4(a0)	;previous list:= list
	move.l a0,(a0)		;next list:= list
	move.l d0,4(a0)		;set block-size in list
	rts

Copy_Mem
***********************
*  copy memory-block  *
***********************
;a0,source-addr
;a1,destination-addr
;d0,block-size
;***  O P T I M I Z E !!!  ***

	movem.l d0/a0-a1,-(a7)
	cmp.l a0,a1		;check on block-overlapping
	bls.s 3$		;destin-addr is upper addr? =no
				;--- destin-addr is upper addr ---
	add.l d0,a0		;add block-size to addrs
	add.l d0,a1
	bra.s 4$
2$	move.l -(a0),-(a1)	;copy downwards
4$	subq.l #1,d0
	bpl.s 2$
	bmi.s 5$		;finished
				;--- destin-addr is lower addr ---
1$	move.b (a0)+,(a1)+	;copy upwards
3$	subq.l #1,d0
	bpl.s 1$
5$	movem.l d0/a0-a1,-(a7)
	rts


Alloc_Mem
	rts
Free_Mem
	rts

*** char-codes ***
char__		= $09
char_space	= $11