diff --git a/build/misc.tcl b/build/misc.tcl index 965c1da6..acd47259 100644 --- a/build/misc.tcl +++ b/build/misc.tcl @@ -1415,6 +1415,14 @@ respond "*" ":imtran\r" respond "@" "imlac; crash iml_imlac; crash bin\r" respond "@" "\021" +# SYMFORM +respond "*" ":midas imlac;_imsrc; symfor\r" +expect ":KILL" +respond "*" ":imtran\r" +respond "@" "imlac; symfor iml_imlac; symfor bin\r" +respond "@" "\021" +expect ":KILL" + # KLH's Knight TV clock. respond "*" ":midas klh; ts tinyw_klh; clock\r" respond "=" "1\r" diff --git a/doc/programs.md b/doc/programs.md index b9adf6b2..7a3159fb 100644 --- a/doc/programs.md +++ b/doc/programs.md @@ -312,6 +312,7 @@ - SUPARD, draw ARDS graphics to SUPDUP. - SUPDUP, Supdup client. - SWAR, Imlac Spacewar. +- SYMFORM, Imlac symbol editor. - SYSCHK, check up on system job. - SYSLOD, system load histogram. - SYSMSG, displays system messages. diff --git a/src/imsrc/symfor.10 b/src/imsrc/symfor.10 new file mode 100644 index 00000000..5bb04f03 --- /dev/null +++ b/src/imsrc/symfor.10 @@ -0,0 +1,2327 @@ +TITLE NSYMFORM + +PDS4=1 +MAXADR=37777 +.INSRT imlac;IMDEFS > +.insrt imlac;DISFIX > +.ADDR.=1 + +; damn midas! +IF1, EXPUNG HRLS HLRZ MUL + +; keyboard logic levels + SHIFT=400 + CTRL=1000 + REPT=2000 + +; character size definitions + CSIZE=11. + LSIZE=21. + +; display positioning definitions + SIZE=20 ; distance between dots in display + LEFT=660 ; left edge of dot matrix + TOP=600 ; bottom edge of dot matrix + RLEFT=560 ; left edge of character display + RTOP0=300 ; first line + RTOP1=RTOP0-LSIZE ; second line + RTOP2=RTOP1-LSIZE ; third line + +; page xmit protocol character definitions + PXSIZ=100 ; interval between acknowledgements + PXIN=34 ; begin page xmit, request ack + PXOUT=1 ; end page xmit + PXQUT=2 ; quote next character (in or out) + PXACK=6 ; imedit's ack character + +; bits in long vector instructions + %XSIGN=2000 + %YSIGN=2000 + %XYG=4000 + %DOT=20000 + %BRI=10000 + +DEFINE DSP K,D + K + D +TERMIN + + +LOC 30000 + +START: JMS RESET ; reset the world +CONT: JMP INIT ; so can test characters in SSV! + +LOC 30030 + +; reinitialize the world +INIT: LAC [JMP @2] ; set up symfor interrupt dispatching + DAC @[1] + LAC [HANDLR] + DAC @[2] + LAC [ION] + DAC @[3] + LAC [JMP @0] + DAC @[4] +; arm refresh interrupt and start display + LAW REF + ARM + ION + +; main loop -- exciting, isn't it? +LOOP: KSN ;;impure//JMP CONTIN by auto-rpt + JMS KEYIN + JMP LOOP ; loop + +; reset the world +RESET: 0 ;(^r; START) + CLA + DAC DIMDOT + JMS SETBOX + JMS SRCMOD ; normal dump mode is ascii + JMS CLRS ; clear the sketchpad + LAC [BUFFER-1] ; clear the storage area + DAC BUFPNT' +; clear out routine buffer + LAC [J40-1] + DAC 10 + LWC 40 + JMS DACNOP + ISZ 10 + ISZ 10 + LWC 40 + JMS DACNOP + ISZ 10 + ISZ 10 + LWC 37 + JMS DACNOP +; reset routine pointer + JMS ROUTOP ; get to top of routine buffer + JMP @RESET + +; interrupt routine +HANDLR: DAC ASAVE' ; save ac and link + RAR 1 + DAC LSAVE' +; refresh display (only interrupt enabled) +DISP: SCF + DCF + LAC [DLIST] + DLN + +; auto repeat on keyboard +TAUTO: ISZ TICKER + JMP RESTRZ ; hasn't exploded +; here to auto-repeat (first time in we will have waited 20 frames) + CLA ; it exploded here + KRB ; get current keystroke + SAM KEY ; see if key held down long enough + JMP RESTRZ ; no + LWC 1 ; now that we have exploded, set timer + DAC TICKER ; to explode on every frame + LAC [JMP CONTIN] + DAC LOOP ; impure dispatch, the only way !! +; restore ac, link and return +RESTRZ: LAC LSAVE + RAL 1 + LAC ASAVE + JMP @[3] + +; keyboard reader and command dispatch +KEYIN: 0 + CLA + KRC + DAC KEY' + LWC 20 ; set auto repeat clock + DAC TICKER' +CONTIN: LAC [KSN] ; restore listen loop + DAC LOOP + LWC CMDSIZ + DAC CNT' + LAC [CMDTAB-1] + DAC 10 + LAC KEY +KEY1: SAM @10 ; is this it? + JMP KEYLUP ; loop + LAC @10 ; yes, dispatch + DAC TMP' + JMS @TMP + NOP ; some skip return + JMP @KEYIN ; back to main loop +; next possibility +KEYLUP: ISZ 10 + ISZ CNT + JMP KEY1 + JMP @KEYIN + +RKBD: 0 + KSF + JMP .-1 + CLA + KRC + DAC KEY' + JMP @RKBD + +KEYASC: 0 ;(f7) -- ascii cursor to char typed + JMS RKBD + LWC KEYSIZ + DAC CNT' + LAC [KEYTAB-1] + DAC 10 + LAC KEY +KALUP: SAM @10 + JMP .+3 + LAC @10 + JMP KEYJMP + ISZ 10 + ISZ CNT + JMP KALUP +; ran out of possibilities + AND [CTRL+REPT] + ASZ + JMP KEYLOS + LAC KEY + AND [377] + SAD [377] + JMP KEYLOS + SUB [240] + ASP + JMP KEYLOS + ADD [40] +KEYJMP: JMS ROUASC + JMP @KEYASC ; none of the above, return +KEYLOS: BEL + JMP @KEYASC + +; table of character transformations +KEYTAB: DSP CTRL+254,133 ; c , = [ + DSP CTRL+255,137 ; c - = _ + DSP CTRL+256,135 ; c . = ] + DSP CTRL+257,134 ; c / = \ + DSP CTRL+260,174 ; c 0 = | (vertical bar) + DSP CTRL+266,176 ; c 6 = ~ (tilde) + DSP CTRL+267,140 ; c 7 = ` (accent grave) + DSP CTRL+270,173 ; c 8 = { (left curly bracket) + DSP CTRL+271,175 ; c 9 = } (right curly bracket) + DSP CTRL+272,136 ; c : = ^ + DSP CTRL+273,100 ; c ; = @ +KEYSIZ=<.-KEYTAB>/2 + +; return control to SSV, without fixing up buffer size +RETSSV: 0 + IOF + JMP @.+1 + 100 +; return control to SSV, but fix up buffer size +QUTSSV: 0 + IOF + JMP @.+1 + 101 + +; move cursor to top of routine buffer +ROUTOP: 0 + LAW 40 ; ascii 40 + DAC RASCII + LAC [J40] + DAC ROUPTR' + LAC [DLXA RLEFT,] ; fix up cursor display to correspond + DAC @[DROUX] + LAC [DLYA RTOP0,] + DAC @[DROUY] + JMS DISASC + JMP @ROUTOP + +ROUASC: 0 + SUB [40] + ASP + JMP BLOSER ; < 40 + SUB [40] + ASM + JMP ROUAS1 + ADD [40] + DAC RTMP + ADD [40] + DAC RASCII + LAC [DLYA RTOP0,] + DAC @[DROUY] + LAC RTMP' + ADD [J40] + JMP BLADDR +ROUAS1: SUB [40] + ASM + JMP ROUAS2 + ADD [40] + DAC RTMP + ADD [100] + DAC RASCII + LAC [DLYA RTOP1,] + DAC @[DROUY] + LAC RTMP + ADD [J100] + JMP BLADDR +ROUAS2: SUB [37] + ASM + JMP BLOSER ; > 176 + ADD [37] + DAC RTMP + ADD [140] + DAC RASCII + LAC [DLYA RTOP2,] + DAC @[DROUY] + LAC RTMP + ADD [J140] + JMP BLADDR +; here for losers +BLOSER: LAC [JLOSER'] + DAC ROUPTR + JMP @ROUASC +BLADDR: DAC ROUPTR + LAC RTMP + JMS MUL + CSIZE + SAL 1 + ADD [DLXA RLEFT,] + DAC @[DROUX] + JMS DISASC + JMP @ROUASC + ; move the drawing cursor around on the sketchpad + +; move drawing cursor to right +RITE: 0 + LAC XCNT' ; x coord + SAD [3] ; 3 is max + JMP @RITE ; already at max + LAC XCNT ; increment x coord + IAC + DAC XCNT + LAW SIZE*2 ; increment x loc of cursor + ADD @[XTO] + DAC @[XTO] + ISZ RITE + JMP @RITE + +; move drawing cursor to the left +LFT: 0 + LAC XCNT + SAD [-3] + JMP @LFT + LWC 1 + ADD XCNT + DAC XCNT + LWC SIZE*2 + ADD @[XTO] + DAC @[XTO] + ISZ LFT + JMP @LFT + +; move drawing cursor up +UP: 0 + LAC YCNT' + SAD [3] + JMP @UP + LAC YCNT + IAC + DAC YCNT + LAW SIZE*2 + ADD @[YTO] + DAC @[YTO] + ISZ UP + JMP @UP + +; move drawing cursor down +DOWN: 0 + LAC YCNT + SAD [-3] + JMP @DOWN + LWC 1 + ADD YCNT + DAC YCNT + LWC SIZE*2 + ADD @[YTO] + DAC @[YTO] + ISZ DOWN + JMP @DOWN + ; number display +; called with: 17/ number buffer-1 +; ac/ number + +; display decimal +NUMDIS: 0 + AND [7777] + DAC TT' + LAC @NUMDIS + DAC 17 + ISZ NUMDIS + LAC [SUBT] + DAC PTR0 ; set subtract pointer for base conversion + JMS ANYDIS + JMP @NUMDIS + +; display octal +OCTDIS: 0 + AND [7777] + DAC TT' + LAC @OCTDIS + DAC 17 + ISZ OCTDIS + LAC [OCTT] + DAC PTR0 + JMS ANYDIS + JMP @OCTDIS + +; called with PTR0 and 17 already set up +ANYDIS: 0 + CAL ; in 4 decimal digits + DAC DFLAG' ; zero to kill leading zeros + LWC 4 + DAC INNER' ; set 4 decimal digits + +GOZAP: LAC INNER + IAC + ASM + ISZ DFLAG + CAL + XAM TT ; load buffer size +SUBR: SUB @PTR0 ; divide loop for base conversion + ASP + JMP .+3 + ISZ TT ; increment digit count + JMP SUBR + ADD @PTR0 ; restore + XAM TT ; load digit, store dividend + ASZ ; is digit zero? + JMP NONA + SAM DFLAG ; suppress zeros? + JMP NONA+1 + LAC [DNOP] + JMP WHAMZ + +NONA: ISZ DFLAG + ADD [DZERO] ; get address of proper djmp + DAC TMP + LAC @TMP +WHAMZ: DAC @17 ; put it out in the display list + ISZ PTR0 ; advance subpointer + ISZ INNER ; check for all four digits + JMP GOZAP ; continue to continue + JMP @ANYDIS ; exit + +; power of ten table +SUBT: 1000. + 100. + 10. + 1. + +; power of eight table +OCTT: 1000 + 100 + 10 + 1 + +; number routine table +DZERO: DTXT [0123456789] + ; clear the screen +CLRS: 0 + LAC [DRJM] + DAC @[INCJMP] + CLA + DAC @[HIBEG-1] ; set the list boundary + DAC @[BUFEND] ; set the dhlt + LAC [DJMP CURSOR,] + DAC @[HIBEG] ; set the inline cursor + LAC [BUFEND] ; set the jump over the gap + DAC CHRPNT' + JMS ADRGAP + LAC [DJMP HIBEG,] + DAC @[HIJUMP] ; set the variable start pointer + LAC [HIBEG] + DAC CURPNT' ; cursor shove pointer + LAC [HIBEG-1] + DAC OFFHI' ; set the varible start-1 pointer + JMS COORD + JMS DLINES + JMP @CLRS + +; move cursor left one vector in dlist +RTAR: 0 + LAC @CHRPNT + ASN + JMP RTARX + LAC CHRPNT + DAC 10 + LAC CURPNT + DAC 11 + LAC @10 + DAC @11 + LAC [DJMP CURSOR,] ; put new cursor + DAC @11 + LAW 2 ; change after-pointer + ADD CHRPNT + DAC TEMPNT' +;!should turn display off + JMS ADRGAP ; new gap jump + LAC @CHRPNT ; move first word of LV + DAC @CURPNT +;till here + LAC TEMPNT ; fix up after-pointer + DAC CHRPNT + LAW 2 ; fix up before-pointer + ADD CURPNT + DAC CURPNT + JMS COORD + JMP @RTAR +RTARX: ISZ RTAR + JMP @RTAR + +; move left one vector in dlist +LFAR: 0 + LAC CURPNT + SAM [HIBEG] + JMP .+3 + ISZ LFAR + JMP @LFAR + LWC 2 + ADD CURPNT + DAC TEMPNT + LWC 3 + ADD CHRPNT + DAC 11 ; output + LWC 3 + ADD CURPNT + DAC 10 ; input + LAC @10 ; move first word + DAC @11 + LAC 10 ; new curpnt + DAC CURPNT + LAC 11 ; and chrpnt + DAC CHRPNT + LAC @10 ; move 2nd word + DAC @11 +;!display off + LAC [DJMP CURSOR,] + DAC @TEMPNT ; move cursor + LAC CHRPNT + JMS ADRGAP ; new jump +;till here + JMS COORD + JMP @LFAR ; return + +; move cursor to end of dlist +HOME: 0 + JMS RTAR + JMP .-1 ; right arrow forever + JMS COORD + JMP @HOME + +; move cursor to start of dlist +HOMEUP: 0 + JMS LFAR + JMP .-1 ; left arrow forever + JMP @HOMEUP + +; address and subroutine conversion + +; make djmp across the gap +ADRGAP: 0 + JMS ADRJMP + DAC @[GAP] + JMP @ADRGAP + +; make an address into a djmp +ADRJMP: 0 + AND [17777] + SUB [010000] + ASM ; skips if < 10000 + ADD [070000] + ADD [070000] + JMP @ADRJMP + +; makes address into djms +ADRJMS: 0 + AND [17777] + SUB [010000] + ASM + ADD [070000] + ADD [060000] + JMP @ADRJMS + +; make a djmp (or djms) into an address +JMPADR: 0 + AND [107777] ; get rid of no.6 bit + ASP + XOR [110000] ; transfer the 10000 bit + ADD [20000] + JMP @JMPADR + +; this obscene routine makes sure drawing origin is at normal ssv +; cursor position -- it is too disgusting to even look at +COORD: 0 + LAC [DNOP] + DAC @[XTO] + DAC @[YTO] + JMS VCTINC + CLA + DAC XCNT + DAC YCNT + DAC XDIS' ; clear displacement + DAC YDIS' + LAW LEFT ; default start is top left + DAC XSTART' + LAW TOP + DAC YSTART' + LAC [HIBEG-1] + DAC TEMPNT + +; here to loop going right until we hit the cursor +CFORW: ISZ TEMPNT + LAC @TEMPNT + SAD [DJMP CURSOR,] ; cursor? + JMP COORDX ; yes, quit + +; long vector? + JMS LVXY + LAC XTMP + ADD XDIS + DAC XDIS + LAC YTMP + ADD YDIS + DAC YDIS + JMP CFORW + +; here to leave +COORDX: LAC XSTART + ADD XDIS + DAC XCUR' ; new current X drawing origin + SAL 1 + IOR [DLXA 0,] + DAC @[XTO] + LAC YSTART + ADD YDIS + DAC YCUR' ; new current Y drawing origin + SAL 1 + IOR [DLYA 0,] + DAC @[YTO] +COORDQ: JMP @COORD + +LVXY: 0 + DAC LONG1 + AND [1777] + DAC XTMP' + LAC LONG1 + AND [%XSIGN] + ASN + JMP .+4 + LAC XTMP + CIA + DAC XTMP + + ISZ TEMPNT + LAC @TEMPNT + DAC LONG2 + AND [1777] + DAC YTMP' + LAC LONG2 + AND [%YSIGN] + ASN + JMP .+4 + LAC YTMP + CIA + DAC YTMP + + LAC LONG2 + AND [%XYG] + ASN + JMP @LVXY + LAC XTMP + XAM YTMP + DAC XTMP + JMP @LVXY + +; remove vector to right of cursor +FDELET: 0 + LAC @CHRPNT ; get character + ASN + JMP @FDELET ; exit for deleting end of list + LAW 2 ; one character + ADD CHRPNT ; any number + DAC CHRPNT ; new chrpnt + JMS ADRGAP ; new jump + JMS COORD + JMP @FDELET + +; remove vector to left of cursor +DELETE: 0 + JMS LFAR + JMS FDELET + JMP @DELETE + +LINE: 0 + JMS DELTA + LAC LINTYP + JMS DRWLIN + JMP @LINE + +OPLINE: 0 + LAC LINTYP + SAM [%BRI] + JMP .+3 + JMS DLINES + JMP .+2 + JMS BLINES + JMS LINE + JMP @OPLINE + +BLINE: 0 + JMS BLINES + JMS LINE + JMP @BLINE + +DLINE: 0 + JMS DLINES + JMS LINE + JMP @DLINE + +; insert a bright line in dlist +BLINES: 0 + LAC [DJMS D102,] + DAC @[DLMODE] + LAC [%BRI] + DAC LINTYP' + JMP @BLINES + +; insert a dim line in dlist +DLINES: 0 + LAC [DJMS D104,] + DAC @[DLMODE] + LAC DIMDOT' + DAC LINTYP' + JMP @DLINES + +; set up xpos and ypos for drawing vectors +DELTA: 0 + LAC XCUR + AND [7777] + DAC XPOS' + LAC @[XTO] + AND [7777] + SAR 1 + SUB XPOS + DAC XPOS + LAC YCUR + AND [7777] + DAC YPOS' + LAC @[YTO] + AND [7777] + SAR 1 + SUB YPOS + DAC YPOS +; reset world + JMP @DELTA + +DOTTER: 0 + LAC DIMDOT + XOR [%BRI+%DOT] + DAC DIMDOT + LAC [HIBEG] + DAC TMP +DOTLU1: LAC TMP + SAM CURPNT + JMP .+3 + LAC CHRPNT + DAC TMP + SAD [BUFEND] + JMP @DOTTER + ISZ TMP + LAC @TMP + AND [%BRI+%DOT] + SAD [%BRI+%DOT] + JMP .+3 + ASZ + JMP DOTLUP + LAC @TMP + XOR [%BRI+%DOT] + DAC @TMP +DOTLUP: ISZ TMP + JMP DOTLU1 + +FINHCK: 0 + JMS OPEN + JMS FINISH + JMS CLOSE + JMS ROURGT + JMP @FINHCK + JMP @FINHCK + +; finish a character +FINISH: 0 + JMS RTAR + JMP .-1 + LAC CCX + JMS MULSIZ + ADD [DLXA LEFT,] ;bottom right hand corner + SUB @[XTO] ;where are we? + SAR 3 + SAR 2 + DAC XFIN' +; set up X inst. + ASZ + JMP .+3 + LAC [NOP] ;even with corner + JMP FINX + ASM + JMP .+3 + LAC [JMS LFT] ;right of it + JMP FINX + LAC XFIN ;left of it + CIA + DAC XFIN + LAC [JMS RITE] +FINX: DAC FXDONE +; here to set up Y + LAC [DLYA TOP,] + SUB @[YTO] + SAR 3 + SAR 2 + DAC YFIN' +; set up Y inst. + ASZ + JMP .+3 + LAC [NOP] ;level with it + JMP FINY + ASM + JMP .+3 + LAC [JMS DOWN] ;above it + JMP FINY + LAC YFIN ;below it + CIA + DAC YFIN + LAC [JMS UP] +FINY: DAC FYDONE + +FINLUP: LAC XFIN + IOR YFIN + ASN + JMP @FINISH +; move x +FXDONE: NOP + JMP FYDONE + ISZ XFIN + JMP FXDONE + LAC [NOP] + DAC FXDONE +; move y +FYDONE: NOP + JMP FINDRW + ISZ YFIN + JMP FYDONE + LAC [NOP] + DAC FYDONE +; draw +FINDRW: JMS FULL + JMP @FINISH + JMS DLINE + JMP FINLUP + +FULL: 0 + LAC CURPNT + IAC + SAM CHRPNT + ISZ FULL + JMP @FULL + +; draw a long vector of given size +DRWLIN: 0 +; what kind of line? passed in ac + DAC LONG2 + + JMS FULL + JMP @DRWLIN + +; draw line (XEP,YEP) --> (XP,YP) +; x + LAC XPOS + ASM + JMP DXSMAG + CIA + DAC XPOS + ADD [%XSIGN] +DXSMAG: DAC XSMAG' +; y + LAC YPOS + ASM + JMP DYSMAG + CIA + DAC YPOS + ADD [%YSIGN] +DYSMAG: DAC YSMAG' +; check whether y or x greater + LAC XPOS + SUB YPOS + ASM + JMP LNGPUT +; y greater than x, must switch them +; exchange x and y -- greater in first word always + LAC XSMAG + XAM YSMAG + DAC XSMAG + LAC [%XYG] ; indicate y was greater + IOR LONG2 + DAC LONG2 +; now set up DLV in source buffer +LNGPUT: LAC XSMAG + IOR [40000] + DAC LONG1 + LAC YSMAG + IOR LONG2 + ASN ;dim, y=0, solid? + LAC [%YSIGN] ; y = -0 + DAC LONG2 +; here to insert two word grafix object w.o. display glitchery + LAC CURPNT + DAC 10 +; insert second word + LAC LONG2 + DAC @10 +; insert cursor + LAC [DJMP CURSOR,] + DAC @10 +; insert first word + LAC LONG1 + DAC @CURPNT + LAW 2 + ADD CURPNT + DAC CURPNT + JMS COORD + JMP @DRWLIN + +; long vector insertion buffer +LONG1: 0 +LONG2: 0 + +DISASC: 0 + LAC RASCII + JMS OCTDIS + DASCII-1 + JMP @DISASC + +ROURGT: 0 + LAC ROUPTR + SAM [J140+36] + JMP .+3 + ISZ ROURGT + JMP RRXIT1 + SAM [J40+37] + JMP RR100 + LAC [J100] + DAC ROUPTR + LAC [DLYA RTOP1,] + DAC @[DROUY] + LAW 100 + DAC RASCII +RRXIT: LAC [DLXA RLEFT,] + DAC @[DROUX] +RRXIT1: JMS DISASC + LAC @ROUPTR + JMP @ROURGT + +RR100: SAM [J100+37] + JMP RRFOO + LAC [J140] + DAC ROUPTR + LAC [DLYA RTOP2,] + DAC @[DROUY] + LAW 140 + DAC RASCII + JMP RRXIT + +RRFOO: ISZ ROUPTR + ISZ RASCII + LAW CSIZE*2 + ADD @[DROUX] + DAC @[DROUX] + JMP RRXIT1 + +; point at character one to the left +ROULFT: 0 + LAC ROUPTR + SAM [J40] + JMP .+3 + ISZ ROULFT + JMP RLXIT1 + SAM [J100] + JMP RL140 + LAC [J40+37] + DAC ROUPTR + LAC [DLYA RTOP0,] + DAC @[DROUY] + LAW 77 + DAC RASCII +RLXIT: LAC [DLXA >,] + DAC @[DROUX] +RLXIT1: JMS DISASC + LAC @ROUPTR + JMP @ROULFT +RL140: SAM [J140] + JMP RLFOO + LAC [J100+37] + DAC ROUPTR + LAC [DLYA RTOP1,] + DAC @[DROUY] + LAW 137 + DAC RASCII + JMP RLXIT +RLFOO: LWC 1 + ADD RASCII + DAC RASCII + LWC 1 + ADD ROUPTR + DAC ROUPTR + LWC CSIZE*2 + ADD @[DROUX] + DAC @[DROUX] + JMP RLXIT1 + +; copy an existing character to the sketchpad +OPEN: 0 + JMS CLRS + LAC @ROUPTR + SAM [DNOP] + JMS INCVCT + JMP @OPEN + +; copy the sketchpad to a character +CLOSE: 0 + LAC [INCBUF-1] + DAC 10 + LAC BUFPNT + DAC 11 + IAC + DAC BUFTMP' +CLSLUP: LAC @10 + DAC @11 + AND [377] + SAM [X] + JMP CLSLUP + LAC 11 + DAC BUFPNT + LAC BUFTMP + JMS ADRJMS + DAC @ROUPTR + JMP @CLOSE + ; simulate left half to right half in ac +HLRZ: 0 + SAR 3 + SAR 3 + SAR 2 + AND [377] + JMP @HLRZ + +; convert increment mode instructions to long vectors +; in the sketchpad +INCVCT: 0 + JMS JMPADR + DAC PTR1 + LAC @PTR1 + DAC TMP + AND [177400] + SAM [030000] + JMP @INCVCT + JMP INCRTE +; left half +INCLUP: LAC @PTR1 + JMS HLRZ + DAC TMP + AND [200] + ASN + JMP INCESC + LAC TMP + JMS INCDO +; right half +INCRTE: LAC @PTR1' + AND [377] + DAC TMP + AND [200] + ASN + JMP INCESC + LAC TMP' + JMS INCDO + ISZ PTR1' + JMP INCLUP +INCESC: JMP @INCVCT + +INCDO: 0 +; do y + AND [3] + DAC YPOS + LAC TMP + AND [4] + ASN + JMP INCMLY + LAC YPOS + CIA + DAC YPOS +INCMLY: LAC YPOS + JMS MUL + SIZE + DAC YPOS +; do x + LAC TMP + AND [30] + SAR 3 + DAC XPOS + LAC TMP + AND [40] + ASN + JMP INCMLX + LAC XPOS + CIA + DAC XPOS +INCMLX: LAC XPOS + JMS MUL + SIZE + DAC XPOS + LAC TMP + AND [100] + ASZ + JMP .+3 + LAC DIMDOT + JMP .+2 + LAC [%BRI] + JMS DRWLIN + JMP @INCDO + +; multipy ac by distance between dots in matrix +MULSIZ: 0 + JMS MUL + SIZE + SAL 1 + JMP @MULSIZ + +MUL: 0 + DAC MTMP' + LAC @MUL + CIA + DAC MLOOP' + ISZ MUL + CLA + ADD MTMP + ISZ MLOOP + JMP .-2 + JMP @MUL + ; convert long vectors to increment mode bytes +; in the buffer for new character routines +VCTINC: 0 + CLA + DAC INCCNT' + LAC [DRJM] + DAC @[INCJMP] + LAC [HIBEG-1] + DAC 16 + LAC [INCBUF] + DAC PTR0' + CLA + DAC HFLG' + LAC [030000] + DAC @PTR0 + JMP VCTLU1 +VCTLUP: LWC 1 + DAC HFLG' +VCTLU1: LAC @16 + ASN + JMP VCTINX + SAM [DJMP CURSOR,] + JMP VCTLU2 + LWC 1 + ADD CHRPNT + DAC 16 + JMP VCTLU1 +VCTLU2: DAC LONG1 + AND [3777] + SAR 3 + SAR 1 + DAC XPOS + LAC @16 + DAC LONG2 + AND [3777] + SAR 3 + SAR 1 + DAC YPOS + + LAC LONG2 + AND [%XYG] + ASN + JMP INCVX + LAC XPOS + XAM YPOS + DAC XPOS +INCVX: LAC XPOS + AND [%XSIGN_-4] + ASN + JMP INCVY + LAC XPOS + XOR [<%XSIGN_-4>+4] + DAC XPOS +INCVY: LAC YPOS + AND [%YSIGN_-4] + ASN + JMP INCSAL + LAC YPOS + XOR [<%YSIGN_-4>+4] + DAC YPOS + +INCSAL: LAC XPOS + SAL 3 + IOR YPOS + DAC XPOS + + LAC LONG2 + AND [%BRI+%DOT] + SAM [%BRI] + JMP .+4 + LAC XPOS + IOR [100] + DAC XPOS +; inc + LAC XPOS + IOR [200] + DAC XPOS + ISZ INCCNT' + ISZ HFLG' + JMP VCTRTE +VCTLFT: JMS HRLS + DAC @PTR0 + JMP VCTLU1 +VCTRTE: IOR @PTR0 + DAC @PTR0 + ISZ PTR0 + JMP VCTLUP + +VCTINX: LAC PTR0 + SAM [INCBUF] + JMP .+2 + JMP VCTDIS + LAC [INC 0,X] + IOR @PTR0 + ISZ HFLG + JMP .+2 + LAC [INC X,X] + DAC @PTR0 + ISZ PTR0 + LAC [DNOP] + DAC @[INCJMP] +VCTDIS: LAC INCCNT + JMS NUMDIS + DINCNT-1 + JMP @VCTINC + +; simulate right halfword to left +HRLS: 0 + RAL 3 + RAL 3 + RAL 2 + AND [177400] + JMP @HRLS + ; get the locations of the SSV character set characters +GETSSV: 0 + LWC 1 + ADD @[31] ; SSV character table + DAC 10 + LAC [J40-1] + DAC 11 + LWC 40 + JMS LACDAC + ISZ 11 + ISZ 11 + LWC 40 + JMS LACDAC + ISZ 11 + ISZ 11 + LWC 37 + JMS LACDAC + JMP @GETSSV + +; copy the symform characters back to ssv's dispatch table +PUTSSV: 0 + LWC 1 + ADD @[31] ; SSV character table + DAC 11 + LAC [J40-1] + DAC 10 + LWC 40 + JMS LACDAC + ISZ 10 + ISZ 10 + LWC 40 + JMS LACDAC + ISZ 10 + ISZ 10 + LWC 37 + JMS LACDAC + JMP @PUTSSV + +; copy n words from one place to another +; 10/ from +; 11/ to +; ac/ -number to copy +LACDAC: 0 + DAC TMP + LAC @10 + DAC @11 + ISZ TMP + JMP .-3 + JMP @LACDAC + +; fill n words with nops +; 10/ to +; ac/ -number to fill +DACNOP: 0 + DAC TMP + LAC [DNOP] + DAC @10 + ISZ TMP + JMP .-2 + JMP @DACNOP + +SRCBIN: 0 + LAC DMPNEW+1 + SAM [PXNEW] + JMP .+3 + JMS BINMOD + JMP @SRCBIN + JMS SRCMOD + JMP @SRCBIN + +SRCMOD: 0 + LAC [PXNEW] + DAC DMPNEW+1 + LAC [PXSET] + DAC DMPSET+1 + LAC [PXONE] + DAC DMPONE+1 + LAC [JMSNOP] + DAC DMPEND+1 + LAC [DJMS D123,] + DAC @[DMODE] + JMP @SRCMOD + +BINMOD: 0 + LAC [BXSET] + DAC DMPSET+1 + LAC [BXNEW] + DAC DMPNEW+1 + LAC [BXONE] + DAC DMPONE+1 + LAC [SEND37] + DAC DMPEND+1 + LAC [DJMS D102,] + DAC @[DMODE] + JMP @BINMOD + +; send an entire character set +PXSET: 0 + LWC 1 + DAC PXALL' + JMS PXMIT + JMP @PXSET + +; send only newly cons'ed up characters +PXNEW: 0 + CLA + DAC PXALL' + JMS PXMIT + JMP @PXNEW + +; send one character +PXONE: 0 + LWC 1 + DAC PXALL' + LAW PXIN ; start page transmit + JMS XMIT + LWC PXSIZ + DAC LOOPX' + JMS CXMIT + LAW PXOUT + JMS AXMIT + JMP @PXONE + +; send a selection of characters +PXMIT: 0 + JMS ROUTOP + LAW PXIN ; start page transmit + JMS XMIT + LWC PXSIZ + DAC LOOPX' +PXLUP: JMS CXMIT + JMS ROURGT + JMP PXLUP + LAW PXOUT + JMS AXMIT ; end of xmit char + JMP @PXMIT + +; send a character routine +CXMIT: 0 + LAC @ROUPTR + AND [070000] + SAM [DJMS 0,] + JMP @CXMIT + LAC PXALL + ASZ + JMP CXCALL + LAC @ROUPTR + ASM + JMP @CXMIT +CXCALL: LAC @ROUPTR + JMS JMPADR + DAC PTR1 + LAC @PTR1 + DAC TMP + AND [177400] + SAM [030000] + JMP @CXMIT +; send start + LAW "; + JMS AXMIT + LAW 40 + JMS AXMIT + LAW "" + JMS AXMIT + LAC RASCII + JMS AXMIT + LAW "" + JMS AXMIT + JMS XMTRET + JMS NMXMIT + JMS XMTINC + LAW "E + JMS AXMIT + LAW ", + JMS AXMIT + JMP CXRTE +; left half +CXLUP: JMS XMTINC + LAC @PTR1 + JMS HLRZ + DAC TMP + AND [200] + ASN + JMP CXESL + LAC TMP + JMS CXDO + LAW ", + JMS AXMIT +; right half +CXRTE: LAC @PTR1' + AND [377] + DAC TMP + AND [200] + ASN + JMP CXESR + LAC TMP' + JMS CXDO + ISZ PTR1' + JMS XMTRET + JMP CXLUP + +CXESL: LAW "X + JMS AXMIT + LAW ", + JMS AXMIT +CXESR: LAW "X + JMS AXMIT + JMS XMTRET + JMS XMTRET + JMP @CXMIT + +; send an increment mode byte +CXDO: 0 + LAC TMP + AND [100] + ASZ + JMP .+3 + LAW "D + JMP .+2 + LAW "B + JMS AXMIT +; do x + LAC TMP + AND [30] + SAR 3 + DAC XPOS + LAC TMP + AND [40] + ASN + JMP CXMLX + LAW "M + JMS AXMIT +CXMLX: LAC XPOS + AND [3] + JMS DIGXMT +; do y + LAC TMP + AND [3] + DAC YPOS + LAC TMP + AND [4] + ASN + JMP CXMLY + LAW "M + JMS AXMIT +CXMLY: LAC YPOS + AND [3] + JMS DIGXMT + JMP @CXDO + +; send "Dxxx:" where xxx is ascii value of character +NMXMIT: 0 + LAW "D + JMS AXMIT + LAC RASCII' + RAR 3 + RAR 3 + JMS DIGXMT + LAC RASCII + RAR 3 + JMS DIGXMT + LAC RASCII' + JMS DIGXMT + LAW ": + JMS AXMIT + JMP @NMXMIT + +; send a digit +DIGXMT: 0 + AND [7] + ADD ["0] + JMS AXMIT + JMP @DIGXMT + +; send "INC " +XMTINC: 0 + LAW 11 + JMS AXMIT + LAW "I + JMS AXMIT + LAW "N + JMS AXMIT + LAW "C + JMS AXMIT + LAW 40 + JMS AXMIT + JMP @XMTINC + +; send a crlf +XMTRET: 0 + LAW 15 + JMS AXMIT + LAW 12 + JMS AXMIT + JMP @XMTRET + +; binary character set format: +; ascii,,length ; 377,,x ==> end +; ; 0 ==> DNOP + +BXSET: 0 + LWC 1 + DAC PXALL' + JMS BXMIT + JMP @BXSET + +BXNEW: 0 + CLA + DAC PXALL + JMS BXMIT + JMP @BXNEW + +BXONE: 0 + LWC 1 + DAC PXALL + LAW PXIN + JMS XMIT + LWC PXSIZ + DAC LOOPX' + JMS BCXMIT + LAW PXOUT + JMS AXMIT + JMP @BXONE + +; send character set in binary +BXMIT: 0 +; start of pxmit + LWC PXSIZ + DAC LOOPX + LAW PXIN + JMS XMIT +; send table + JMS ROUTOP +SNDTBL: JMS BCXMIT +; move to next routine + JMS ROURGT ; skips at end + JMP SNDTBL +; send trailer + JMS SEND37 + LAW PXOUT + JMS AXMIT + JMP @BXMIT + +JMSNOP: 0 + JMP @JMSNOP + +SEND37: 0 + LAW 377 + JMS SEND8 + JMS XMTRET + JMP @SEND37 + ; send single routine in binary +BCXMIT: 0 + LAC @ROUPTR + AND [070000] + SAM [DJMS 0,] + JMP SNDNOP +; for if not sending old ones + LAC PXALL + ASZ + JMP BCSIZE + LAC @ROUPTR + ASM + JMP @BCXMIT +; how big is routine? +BCSIZE: LAC @ROUPTR + JMS JMPADR + DAC BADDR' ; address of routine +; set up bcnt -- size of routine + SUB [1] + DAC 10 + CLA + DAC BCNT' +RSZLUP: ISZ BCNT + LAC @10 + AND [240] ; and down to inc. and rjm + SAM [40] ; inc - no, rjm - yes + JMP RSZLUP +; send ascii value + LAC RASCII + JMS SEND8 +; send size of routine + LAC BCNT + JMS SEND8 +; now send routine + LAC BCNT + CIA + DAC BCNT +SNDROU: LAC @BADDR + JMS SEND16 + ISZ BADDR + ISZ BCNT + JMP SNDROU + JMP BCXIT +; here for non-routine +SNDNOP: LAC RASCII + JMS SEND8 + CLA ; zero length + JMS SEND8 +; return +BCXIT: JMS XMTRET + JMP @BCXMIT + +; send 4 bits +SEND4: 0 + AND [17] + ADD [100] + JMS AXMIT + JMP @SEND4 + +; send 8 bits +SEND8: 0 + DAC TMP' + SAR 3 + SAR 1 + JMS SEND4 + LAC TMP + JMS SEND4 + JMP @SEND8 + +; send 16 bits +SEND16: 0 + DAC TMP1' + JMS HLRZ + JMS SEND8 + LAC TMP1' + JMS SEND8 + JMP @SEND16 + +BLOAD: 0 +; type carriage return + LAW 15 + JMS XMIT +; set up buffer pointer + LAC BUFPNT + DAC 11 +BLOOP: JMS GET8 + SAD [377] + JMP @BLOAD ; return +; go (and set up ROUPTR) with ascii value + JMS ROUASC +; get length + JMS GET8 + ASN + JMP BLNOP +; count of words in routine + CIA + DAC BCNT +; set up jms to routine + LAC 11 + IAC + JMS ADRJMS + DAC BROUT' ; address of routine +; read routine +BLREAD: JMS GET16 + DAC @11 + ISZ BCNT + JMP BLREAD +; update routine pointer + LAC 11 + DAC BUFPNT' ; pointer to first good location in buffer +; add to table + LAC BROUT + JMP .+2 +BLNOP: LAC [DNOP] +BLJMS: DAC @ROUPTR + JMP BLOOP + +; get word +GET16: 0 + CAL + DAC TMP1' + JMS GET4 + JMS GET4 + JMS GET4 + JMS GET4 + JMP @GET16 + +GET8: 0 + CAL + DAC TMP1' + JMS GET4 + JMS GET4 + JMP @GET8 + +; get good character +GET4: 0 +GETCHR: RSF + JMP .-1 + CAL + RRC + DAC TMP + AND [160] + SAM [100] + JMP GETCHR + LAC TMP + AND [17] + XAM TMP1 + RAL 3 + RAL 1 + IOR TMP1 + DAC TMP1 + JMP @GET4 + +; send with acknowledgement +AXMIT: 0 + JMS XMIT ; send character + SAM [15] ; cr? + JMP .+2 + JMP AXMIT1 ; acknowledge + ISZ LOOPX ; sent too many? + JMP @AXMIT ; no, return +; here too many, ack + LAW PXIN ; send ack character + JMS XMIT +AXMIT1: JMS ACK + JMP @AXMIT + +; here to wait for ack +ACK: 0 + LWC PXSIZ + DAC LOOPX + JMS TGET + SAM [PXACK] ; ack character? + JMP .-2 ; no + JMP @ACK ; yes, return + +; send a single character +XMIT: 0 + TSF + JMP .-1 + TPC + JMP @XMIT + +; receive a character +TGET: 0 + RSF + JMP .-1 + CLA + RRC + AND [177] + JMP @TGET + +SETBOX: 0 + LAW 10. + DAC CCX + JMS SETCCX + LAW 20. + DAC CCY + JMS SETCCY + LAW 11. + DAC UCY + JMS SETUCY + LAW 7 + DAC UCX + DAC LCX + DAC LCY + JMS SETUCX + JMS SETLCX + JMS SETLCY + JMP @SETBOX + +RING: 0 + IAC + SAM [30.] + JMP @RING + LAW 1 + JMP @RING + +; make lower case box +SETLCX: 0 + LAC LCX' + JMS RING + DAC LCX + JMS MULSIZ + ADD [DLXA LEFT,] + DAC @[DLCX] + LAC LCX + JMS NUMDIS + DLCXN-1 + JMP @SETLCX + +SETLCY: 0 + LAC LCY + JMS RING + DAC LCY' + JMS MULSIZ + ADD [DLYA TOP,] + DAC @[DLCY] + LAC LCY + JMS NUMDIS + DLCYN-1 + JMP @SETLCY + +; make upper case box +SETUCX: 0 + LAC UCX' + JMS RING + DAC UCX + JMS MULSIZ + ADD [DLXA LEFT,] + DAC @[DUCX] + LAC UCX + JMS NUMDIS + DUCXN-1 + JMP @SETUCX + +SETUCY: 0 + LAC UCY + JMS RING + DAC UCY' + JMS MULSIZ + ADD [DLYA TOP,] + DAC @[DUCY] + LAC UCY + JMS NUMDIS + DUCYN-1 + JMP @SETUCY + +; make full size box +SETCCX: 0 + LAC CCX + SAL 1 + ADD [DDOTS+3] + DAC TMP' + ADD [2] + SAD [AFTDOT] + LAC [DDOTS+5] + DAC TMP1' + LAC [DRJM] + DAC @TMP1 + LAC [DDSP] + DAC @TMP + LAC CCX + JMS RING + DAC CCX + JMS MULSIZ + ADD [DLXA LEFT,] + DAC @[DCCX] + LAC CCX + JMS NUMDIS + DCCXN-1 + JMP @SETCCX + +SETCCY: 0 + LAC CCY + SAL 1 + ADD [DMATJ+4] + DAC TMP' + ADD [2] + SAD [AFTMAT+1] + LAC [DMATJ+6] + DAC TMP1' + LAC [DJMP AFTMAT,] + DAC @TMP1 + LAC [DJMS DDOTS,] + DAC @TMP + LAC CCY + JMS RING + DAC CCY + JMS MULSIZ + ADD [DLYA TOP,] + DAC @[DCCY] + LAC CCY + JMS NUMDIS + DCCYN-1 + JMP @SETCCY + +TOGLC: 0 + LAC @[DLCJ] + XOR [DNOP#] + DAC @[DLCJ] + JMP @TOGLC + +TOGUC: 0 + LAC @[DUCJ] + XOR [DNOP#] + DAC @[DUCJ] + JMP @TOGUC + +TOGCC: 0 + LAC @[DCCJ] + XOR [DNOP#] + DAC @[DCCJ] + JMP @TOGCC + +TOGMAT: 0 + LAC @[DMATJ] + XOR [DNOP#] + DAC @[DMATJ] + LAC @[CURJMP] + XOR [DNOP#] + DAC @[CURJMP] + JMP @TOGMAT + +CCX: 10. +CCY: 20. + +; variable and constant area + VARIAB + CONSTA + + ;---------------------------------------------------------------- +; command table +;---------------------------------------------------------------- + +CMDTAB: DSP 346,FINISH ; F -- finish character + DSP CTRL+346,FINHCK ; c F -- load, finish, dump move right + DSP 211,KEYASC ; "7" -- move to selected char + DSP 205,RITE ; => -- move draw cursor right + DSP 206,UP ; ^| -- move draw cursor up + DSP 210,LFT ; <= -- move draw cursor left + DSP 204,DOWN ; v| -- move draw cursor down + DSP 217,HOME ; HOME -- move to start of sketch + DSP SHIFT+217,HOMEUP ; s HOME -- move to end of sketch + DSP SHIFT+214,SRCBIN ; s FORM -- toggle dump mode + DSP CTRL+354,SETLCX ; s L -- widen lc box + DSP CTRL+365,SETUCX ; s U -- widen uc box + DSP CTRL+343,SETCCX ; s C -- widen char box + DSP SHIFT+314,SETLCY ; c L -- heighten lc box + DSP SHIFT+325,SETUCY ; c U -- heighten uc box + DSP SHIFT+303,SETCCY ; c C -- heighten char box + DSP 230,SETBOX ; "0" -- reset box sizes + DSP 354,TOGLC ; L -- toggle lc box + DSP 365,TOGUC ; U -- toggle uc box + DSP 343,TOGCC ; C -- toggle char box + DSP 355,TOGMAT ; M -- toggle dot matrix + DSP 237,BLOAD ; TAB -- load a binary character file + DSP CTRL+372,RETSSV ; c Z -- return to ssv + DSP CTRL+361,QUTSSV ; c Q -- quit and return + DSP CTRL+362,RESET ; c R -- reset symfor + DSP CTRL+235,GETSSV ; c "5" -- load SSV character set + DSP CTRL+236,PUTSSV ; c "6" -- dump SSV character set +DMPNEW: DSP 216,PXNEW ; PXMIT -- send new characters +DMPSET: DSP CTRL+216,PXSET ; c PXMIT -- send all characters +DMPONE: DSP 202,PXONE ; XMIT -- send one character +DMPEND: DSP CTRL+202,JMSNOP ; c XMIT -- terminate binary dump + DSP 233,LINE ; ESC -- draw a line + DSP CTRL+233,OPLINE ; c ESC -- draw line opposite type + DSP 342,BLINE ; B -- draw bright line + DSP 344,DLINE ; D -- draw dim line + DSP CTRL+205,RTAR ; c => -- move cursor right + DSP CTRL+210,LFAR ; c <= -- move cursor left + DSP 231,OPEN ; BRK -- copy to sketchpad + DSP 215,CLOSE ; CR -- copy from sketchpad + DSP CTRL+206,ROULFT ; c ^| -- move rcursor left + DSP CTRL+204,ROURGT ; c v| -- move rcursor right + DSP 377,DELETE ; DEL -- delete to left of cursor + DSP 232,FDELET ; "2" -- delete to right of cursor + DSP 214,CLRS ; FORM -- clear sketchpad + DSP 234,DOTTER ; "4" -- toggle dotted mode for invisible lines +CMDSIZ==<.-CMDTAB>/2 + +D040: INC E,D30 + INC D30,D30 + INC D20,X + +D052: INC E,D23 ; * - asterisk + INC B23,B23 + INC DM20,DM20 + INC B2M3,B2M3 + INC D13,BM30 + INC BM30,D3M3 + INC D3M3,D30 + INC D10,X + +D060: INC E,D03 ; 0 - zero + INC B03,B03 + INC B23,B20 + INC B20,B2M3 + INC B0M3,B0M3 + INC BM2M3,BM20 + INC BM20,BM23 + INC D0M3,B23 + INC B23,B23 + INC B23,D3M3 + INC D0M3,D0M3 + INC D0M3,X + +D061: INC E,D33 ; 1 - one + INC D03,D02 + INC D02,B12 + INC B10,B0M3 + INC B0M3,B0M3 + INC B0M3,DM20 + INC B20,B20 + INC D20,D20 + INC X,X + +D062: INC E,D03 ; 2 - two + INC D03,D03 + INC B23,B20 + INC B20,B2M3 + INC B0M2,BM2M1 + INC BM2M1,BM2M1 + INC BM2M1,B0M3 + INC B30,B30 + INC B20,D30 + INC X,X + +D063: INC E,D03 ; 3 - three + INC B2M3,B20 + INC B20,B23 + INC B01,BM32 + INC B32,B01 + INC BM23,BM20 + INC BM20,BM2M3 + INC D3M3,D3M3 + INC D3M3,D20 + INC X,X + +D064: INC E,D30 ; 4 - four + INC D20,B03 + INC B03,B03 + INC B03,BM10 + INC BM2M3,BM2M3 + INC B0M1,B30 + INC B30,B20 + INC D3M3,D0M2 + INC X,X + +D065: INC E,D02 ; 5 - five + INC B2M2,B20 + INC B20,B22 + INC B02,B02 + INC BM22,BM30 + INC BM30,B02 + INC B02,B30 + INC B20,B20 + INC D3M3,D1M3 + INC D0M3,D0M3 + INC X,X + +D066: INC E,D20 ; 6 - six + INC BM22,B03 + INC B02,B02 + INC B23,B20 + INC B20,B2M3 + INC DM3M2,DM3M2 + INC DM20,B22 + INC B20,B20 + INC B2M2,B0M3 + INC BM2M2,BM20 + INC BM20,D30 + INC D30,D30 + INC X,X + +D067: INC E,D03 ; 7 - seven + INC D03,D03 + INC B13,B30 + INC B20,B20 + INC BM1M3,BM1M3 + INC BM1M3,BM1M3 + INC D30,D20 + INC D20,X + +D070: INC E,D20 ; 8 - eight + INC BM22,B02 + INC B22,B20 + INC B20,B22 + INC B02,BM22 + INC BM20,BM20 + INC BM2M2,B0M2 + INC B2M2,D20 + INC D20,B2M2 + INC B0M2,BM2M2 + INC BM20,BM20 + INC D30,D30 + INC D30,X + +D071: INC E,D03 ; 9 - nine + INC B2M3,B20 + INC B20,B23 + INC B03,B02 + INC B02,BM22 + INC BM20,BM20 + INC BM2M2,B0M3 + INC B2M2,B20 + INC B20,B22 + INC D3M3,D0M2 + INC D0M2,X + +D102: INC E,B03 ; B + INC B03,B03 + INC B03,B30 + INC B20,B3M2 + INC B0M2,BM3M2 + INC BM30,BM20 + INC D30,D20 + INC B3M2,B0M2 + INC BM3M2,BM30 + INC BM20,D30 + INC D30,D30 + INC D20,X + +D104: INC E,B03 ; D + INC B03,B03 + INC B03,B20 + INC B20,B2M1 + INC B2M3,B0M2 + INC B0M2,BM2M3 + INC BM2M1,BM20 + INC BM20,D30 + INC D30,D30 + INC D20,X + +D123: INC E,D02 ; S + INC B2M2,B20 + INC B20,B22 + INC B02,BM21 + INC BM21,BM21 + INC BM21,B02 + INC B22,B20 + INC B20,B2M2 + INC D3M3,D0M3 + INC D0M2,D0M2 + INC X,X + ; one line of dot matrix +DDOTS: REPEAT 30.,[ + DLXA > + DDSP + ] + DNOP + DRJM +AFTDOT==.+1 + +; move one box worth in matrix +DXSIZ: DLV D,SIZE,0 + DRJM + +; 6*6 matrix centered on sketching "from" cursor +DINCS: DDSP + REPEAT 6,[ + DJMS DXSIZ + DDSP + ] + DLV D,-,SIZE + DRJM + +; sketching "from" cursor +CURSOR: DJMS XCURT +CURJMP: DNOP + DLV D,-<3*SIZE>,-<3*SIZE> + REPEAT 7, DJMS DINCS + DLV D,<3*SIZE>,-<4*SIZE> +; sketchpad "to" cursor +XTO: DLXA LEFT +YTO: DLYA TOP + DJMS DFROM + +GAP: DJMP BUFEND + +; small box (indicates both "from" and "to" cursor) +DFROM: INC E,DM3M3 + INC B30,B30 + INC B03,B03 + INC BM30,BM30 + INC B0M3,B0M3 + INC D33,X + +; routine cursor -- a box surrounding character pointed at +RCURSO: DLV D,-2,-2 + DLV B,12.,0 + DLV B,0,16. + DLV B,-12.,0 + DLV B,0,-16. + DLV D,2,2 + DRJM + +; triangle cursor +XCURT: DNOP + INC E,DM10 + INC BM2M3,BM2M3 + INC B20,B20 + INC B20,B20 + INC BM23,BM23 + INC D10,X + +; buffer in which increment mode version of +; current character is built +INCJMP: DNOP +INCBUF: BLOCK 100. + +; main display list +DLIST: DSTS 2 ; scale one + DSTB 3 + DADR ; 8k addressing mode + DGD + + DLXA 100 + DLYA 1500 +DCCXN: REPEAT 4, DNOP + DJMS D052 +DCCYN: REPEAT 4,DNOP + DLXA 100 + DLYA <1500-LSIZE> +DUCXN: REPEAT 4, DNOP + DJMS D052 +DUCYN: REPEAT 4, DNOP + DLXA 100 + DLYA <1500-<2*LSIZE>> +DLCXN: REPEAT 4, DNOP + DJMS D052 +DLCYN: REPEAT 4, DNOP + +; useful? character boxes + DLXA LEFT + DLYA TOP + DGB +DCCJ: DNOP +DCCX: DLXA > +DCCY: DLYA > + DLXA LEFT + DLYA TOP + +DUCJ: DNOP +DUCX: DLXA > +DUCY: DLYA > + DLXA LEFT + DLYA TOP + +DLCJ: DNOP +DLCX: DLXA > +DLCY: DLYA > + DLXA LEFT + DLYA TOP + DGD + +; 12.*21. dot matrix +DMATJ: DNOP + REPEAT 30.,[ + DLYA > + DJMS DDOTS + ] + DNOP + DNOP +AFTMAT: + +; dump mode + DLXA 1600 + DLYA 1600 +DMODE: DJMS D102 + +; bright or dim mode? + DLXA 100 + DLYA 1600 +DLMODE: DJMS D102 + +; number of inc's in sketchpad character + DLXA 140 + DLYA 1600 +DINCNT: DNOP + DNOP + DNOP + DNOP + +; ascii value of current character + DLXA RLEFT-140 + DLYA RTOP0 +DASCII: DNOP + DNOP + DNOP + DNOP + +; routine cursor (for picking up and dropping) +DROUX: DLXA RLEFT +DROUY: DLYA RTOP0 + DJMS RCURSO + +; display characters + DLXA RLEFT + DLYA RTOP0 +J40: REPEAT 40, DNOP + DLXA RLEFT + DLYA RTOP1 +J100: REPEAT 40, DNOP + DLXA RLEFT + DLYA RTOP2 +J140: REPEAT 40, DNOP + +; increment mode characters +IRP N,,[1,2,3,4,5,6,7]Y,,[1320,1244,1160,1064,760,644,520] + DLXA 100 + DLYA Y + DTXT [N! ] + DSTS N + DJMS INCJMP + DSTS 2 +TERMIN + +; sketchpad +VCTBUF: DLXA LEFT + DLYA TOP +HIJUMP: 0 ; display dispatch point no. 1 + 0 ; buffer zero to mark the beginning of it all +HIBEG: 0 ; start of active dlist + BLOCK 500. +BUFEND: 0 + +; new character buffer starts here +BUFFER: 0 + + END START +  \ No newline at end of file