DEFINE PAGE00, SPACE=ROM SEGMENT PAGE00 PUBLIC AnimateRunIndicator,DispHexA,PutS,PutC,curBlink,SaveOScreen,DispHexHL,EraseEOL,ClrLCDFull PUBLIC _LCD_COMMAND,SetXAutoIncrementMode,SetYAutoIncrementMode,IPutSB,PutMap,ClrScrnFull,ClrTxtShd PUBLIC saveTR,restoreTR,showCursor,CursorOff,CursorOn,hideCursor,RunIndicOn,IPutC,LCD_DRIVERON PUBLIC RestoreTextShadow,rstrpartialWin,savepartialWin,PutPS,VPutMap,VPutS,VPutSCenter EXTERN IsAtEditTail,IsAtBtm,LCDDelay,ATimes16,NZIf83Plus,_GetCharacterBitmap,_GetSmallFontCharacterBitmap EXTERN _GetSStringLength include "includes\os2.inc" PutPS: ld b,(hl) $$: inc hl ld a,(hl) call PutC djnz $B ret RestoreTextShadow: ld hl,0 ld (curRow),hl ld hl,textShadow ld b,127 $$: ld a,(hl) inc hl call IPutC djnz $B ld a,(hl) call PutMap rstrpartialWin: ld hl,(textShadCur) ld (curRow),hl ld a,(textShadAlph) ld (flags+shiftFlags),a ld a,(textShadIns) and 0EFh ld hl,flags+textFlags or (hl) ld (hl),a ret savepartialWin: ld hl,(curRow) ld (textShadCur),hl ld a,(winTop) ld (textShadTop),a ld a,(flags+shiftFlags) ld (textShadAlph),a ld a,(flags+textFlags) and 10h ld (textShadIns),a ret LCD_DRIVERON: ld a,40h call LCDDelay out (LCDinstPort),a ld a,5 call LCDDelay out (LCDinstPort),a ld a,1 call LCDDelay out (LCDinstPort),a ld a,lcdTurnOn call LCDDelay out (LCDinstPort),a ld a,16h call NZIf83Plus jr nz,$F ld a,17h $$: call LCDDelay out (LCDinstPort),a ld a,8 call NZIf83Plus jr nz,$F ld a,0Bh $$: call LCDDelay out (LCDinstPort),a ld a,(contrast) add a,18h or 0C0h call LCDDelay out (LCDinstPort),a ret RunIndicOn: ;TODO: come back to this... ret CursorOff: CursorOn: ;TODO: come back to these... ret ClrScrnFull: call ClrLCDFull ClrTxtShd: bit appTextSave,(iy+appFlags) ret z ld hl,textShadow ld (hl),' ' ld de,textShadow+1 ld bc,127 ldir ret saveTR: bit indicInUse,(iy+indicFlags) ret nz push af push bc push de push hl push ix set indicInUse,(iy+indicFlags) ld b,8 ld ix,indicMem call SetIndicatorCoordinates call LCDDelay in a,(LCDdataPort) $$: call LCDDelay in a,(LCDdataPort) ld (ix+0),a inc ix djnz $B jr endTR restoreTR: bit indicInUse,(iy+indicFlags) ret z push af push bc push de push hl push ix ld b,8 ld ix,indicMem call SetIndicatorCoordinates $$: ld a,(ix+0) inc ix call LCDDelay out (LCDdataPort),a djnz $B res indicInUse,(iy+indicFlags) ei endTR: pop ix pop hl pop de pop bc pop af ret SetIndicatorCoordinates: di ld a,2Bh call LCDDelay out (LCDinstPort),a ld a,80h call SetLCDRow call SetXAutoIncrementMode ret _LCD_COMMAND: call LCDDelay out (LCDinstPort),a ret IPutSB: push bc ld a,(hl) inc hl call PutC pop bc djnz IPutSB ret ClrLCDFull: push af ld hl,flags+shiftFlags push hl ld a,(hl) and 1 push af res 0,(hl) ld b,128 ld a,0B8h di $$: push bc push af call ClearRow pop af sub 8 pop bc cp b jr nc,$B ; ei nop pop af pop hl or (hl) ld (hl),a pop af ret ClearRow: di ld d,a ld e,20h ClearRowLoop: ld a,d call SetLCDRow call SetXAutoIncrementMode ld b,8 ld a,e call LCDDelay out (LCDinstPort),a $$: xor a call LCDDelay out (LCDdataPort),a djnz $B inc e ld a,e cp 2Ch jr nz,ClearRowLoop ret SetLCDRow: call SetYAutoIncrementMode cp 80h ret c cp 0C0h ret nc call LCDDelay out (LCDinstPort),a ret SetYAutoIncrementMode: push af ld a,lcdYAutoIncrementMode $$: call LCDDelay out (LCDinstPort),a pop af ret SetXAutoIncrementMode: push af ld a,lcdXAutoIncrementMode jr $B SaveOScreen: ;Save LCD contents to saveSScreen from APD power-off ;TODO: come back to this ret AnimateRunIndicator: ld hl,indicCounter dec (hl) ret nz ;Animate it ;TODO: make this actually, oh, I don't know, animate it COMMENT ~ ld hl,(curRow) push hl ld hl,6 ld (curRow),hl ld a,(appBackUpScreen+100) or a jr z,$F xor a ld (appBackUpScreen+100),a ld a,' ' call PutC pop hl ld (curRow),hl ret $$: ld a,1 ld (appBackUpScreen+100),a ld a,'B' call PutC pop hl ld (curRow),hl ~ ret PutS: ld a,(hl) or a ret z call PutC inc hl jr PutS EraseEOL: push af push bc push de push hl ld a,(curCol) push af sub 16 jr nc,EraseEOL_1 neg ld b,a ld a,' ' dec b jr z,EraseEOL_2 $$: call PutC djnz $B EraseEOL_2: call PutMap ; ei EraseEOL_1: pop af ld (curCol),a pop hl pop de pop bc pop af ret newLine: push af ld a,(curRow) inc a ld (curRow),a xor a ld (curCol),a pop af ret PutC: push af push hl cp 0D6h jr nz,$F call EraseEOL call newLine ld a,(winBtm) ld l,a ld a,(curRow) cp l jr nc,PutC_Done ld a,3Ah $$: call PutMap res 0,(iy+8) ld hl,curCol inc (hl) ld a,(hl) cp 16 call nc,newLine PutC_Done: pop hl pop af ret PutMap: push af push bc push de push hl push ix bit appTextSave,(iy+appFlags) jr z,$F call GetTextShadowOffset ld (hl),a $$: or a jr z,$F cp 0F5h jr c,PutMap_1 $$: ld a,0D0h PutMap_1: ld l,a ld h,0 add hl,hl add hl,hl add hl,hl call _GetCharacterBitmap push hl pop ix ld a,(curRow) add a,a add a,a add a,a add a,80h ld (curXRow),a ld a,(curCol) and 1Fh add a,20h ld b,a xor a call LCDDelay out (LCDinstPort),a ld a,(curXRow) call SetLCDRow call SetXAutoIncrementMode ld a,b call LCDDelay out (LCDinstPort),a ld b,8 PutMap_Loop1: xor a dec b jr z,$F ld a,(ix+0) inc ix $$: inc b sla a bit textInverse,(iy+textFlags) jr z,PutMap_3 xor 3Eh PutMap_4:push af ld a,(curCol) and 1Fh jr z,PutMap_2 add a,1Fh call LCDDelay out (LCDinstPort),a call SetLCDRow_1 or 1 bit 0,(iy+8) jr z,$F and 3Eh $$: call LCDDelay out (LCDdataPort),a ld a,(curCol) and 1Fh add a,20h call LCDDelay out (LCDinstPort),a call SetLCDRow_2 PutMap_2: pop af jr PutMap_5 PutMap_3: bit 0,(iy+8) jr nz,PutMap_4 PutMap_5: call LCDDelay out (LCDdataPort),a djnz PutMap_Loop1 ld a,1 call LCDDelay out (LCDinstPort),a COMMENT ~ ld b,a in a,(6) push af ld a,7Fh out (6),a push hl ex (sp),hl ld hl,PutC_ret ex (sp),hl push hl ld hl,408Ah ld e,(hl) inc hl ld d,(hl) ld hl,10 add hl,de ld e,(hl) inc hl ld d,(hl) ex de,hl push bc ld a,0CDh ld bc,0FFFFh cpir pop af ld e,(hl) inc hl ld d,(hl) push de pop ix pop hl jp (ix) PutC_ret: pop bc ld a,b out (6),a ~ pop ix pop hl pop de pop bc pop af ret SetLCDRow_1: call LCDDelay in a,(LCDdataPort) call LCDDelay in a,(LCDdataPort) SetLCDRow_2: push af ld a,(curXRow) add a,8 sub b call SetLCDRow call SetXAutoIncrementMode pop af ret GetTextShadowOffset: push af push bc push de ld hl,(curRow) ld a,l call ATimes16 add a,h ld l,a ld h,0 ld de,textShadow add hl,de pop de pop bc pop af ret ifastcopy: di ld a,80h out (10h),a ld hl,9340h-12-(-(12*64)+1) ifastcopy_start: ld a,20h ld c,a inc hl dec hl fastCopyAgain: ld b,64 inc c ld de,-(12*64)+1 out (10h),a add hl,de ld de,10 fastCopyLoop: add hl,de inc hl inc hl inc de ld a,(hl) out (11h),a dec de djnz fastCopyLoop ld a,c cp 2Ch jr nz,fastCopyAgain ret ;Mostly for debugging purposes only DispHexHL: push af push bc push de push hl push ix ld a,h call DispHexA ld a,l call DispHexA pop ix pop hl pop de pop bc pop af ret ;Mostly for debugging purposes only DispHexA: push de push ix push af push hl push bc push af rrca rrca rrca rrca call dispha pop af call dispha pop bc pop hl pop af pop ix pop de ret dispha:and 15 cp 10 jr nc,dhlet add a,48 jr dispdh dhlet: add a,55 dispdh:call IPutC ret ;For debugging purposes only IPutC: push af push bc push de push hl push ix call PutC pop ix pop hl pop de pop bc pop af ret curBlink: ;TODO: this needs some tweaking to support the small font if/when we get to it ld hl,curTime dec (hl) ret nz push af in a,(interruptEnPort) push af ld a,INTERRUPT_MASK_POWER out (interruptEnPort),a pop af out (interruptEnPort),a pop af bit curOn,(iy+curFlags) jr z,showCursor hideCursor: push af ld a,32h ;hard-coded start for curTime ld (curTime),a pop af bit curOn,(iy+curFlags) ret z ld a,(curUnder) ld hl,(curRow) push hl call PutC pop hl ld (curRow),hl curBlinkDone: res curOn,(iy+curFlags) pop af ret showCursor: bit curAble,(iy+curFlags) ret z push af push de push hl push ix ld a,32h ;hard-coded start for curTime ld (curTime),a call IsAtEditTail jr nz,atEditTail bit textInsMode,(iy+textFlags) jr nz,$F call IsAtBtm jr z,$F ld a,(de) cp 3Fh jr nz,atEditTail $$: ld a,0F1h jr dispChar atEditTail: ld a,0E0h bit textInsMode,(iy+textFlags) jr z,$F add a,4 $$: ld h,(iy+shiftFlags) bit 3,h jr z,$F inc a jr dispChar $$: bit 4,h jr z,dispChar add a,2 bit 5,h jr z,dispChar inc a dispChar: ld b,a ld a,(curRow) or a ld a,b jr nz,$F nop $$: ld hl,(curRow) push hl call PutC pop hl ld (curRow),hl curBlink2Done: set curOn,(iy+curFlags) pop ix pop hl pop de pop af ret VPutSCenter: push hl call _GetSStringLength pop hl ld a,95 sub c jr nc,$F xor a $$: srl a ld (penCol),a VPutS: push af push de push ix VPutSLoop: ld a,(hl) inc hl or a jr z,$F call VPutMap jr nc,VPutSLoop $$: pop ix pop de pop af ret VPutMap: push bc ld b,a ld a,i jp pe,$F ld a,i $$: push af ld a,b di push hl call _GetSmallFontCharacterBitmap push hl pop ix ld e,(ix+0) ld d,0 ld hl,vpmTable-1 add hl,de ld d,(hl) push de ld a,(penRow) ld b,a or 80h ld (curXRow),a call SetLCDRow call SetXAutoIncrementMode call vpm1 ld a,(penCol) ld e,a srl a srl a srl a or 20h ld (curY),a call LCDDelay out (LCDinstPort),a ld d,0 add hl,de ld a,e pop de add a,e cp 60h ccf jr c,vpmReturnC push de ld (penCol),a ld a,l and 7 ld c,a srl h rr l srl h rr l srl h rr l ld de,plotSScreen add hl,de pop de ld b,6 ld a,8 sub c sub (ix+0) inc ix jp m,vpm3 ld c,a inc c vpmLoop: push bc ld b,c ld a,(hl) call LCDDelay in a,(LCDdataPort) call LCDDelay in a,(LCDdataPort) push af ld a,(curXRow) call SetLCDRow call SetXAutoIncrementMode pop af jr vpm4 $$: rrca vpm4: djnz $B bit textInverse,(iy+textFlags) jr z,$F ld b,a ld a,0FFh xor d or b jr vpm5 $$: and d vpm5: xor (ix+0) inc ix ld b,c jr vpm6 $$: rlca vpm6: djnz $B call LCDDelay out (LCDdataPort),a ld hl,curXRow inc (hl) pop bc ld a,(hl) cp 0C0h jr nc,vpmReturn djnz vpmLoop vpmReturn: pop hl pop af jp po,$F ei $$: pop bc xor a ret vpm1: inc b ld hl,0 ld de,60h jr vpm2 $$: add hl,de vpm2: djnz $B ret vpmReturnC: pop hl pop af jp po,$F ei $$: pop bc scf ret vpm3: neg ld c,a vpm9: push bc ld b,c call LCDDelay in a,(LCDdataPort) call LCDDelay in a,(LCDdataPort) push af ld a,(curXRow) call SetLCDRow call SetXAutoIncrementMode pop af push af ld a,(curY) inc a call LCDDelay out (LCDinstPort),a call LCDDelay in a,(LCDdataPort) call LCDDelay in a,(LCDdataPort) push af ld a,(curXRow) call SetLCDRow call SetXAutoIncrementMode pop af ld e,a pop af vpm10: sla e rla jr nc,$F inc e $$: djnz vpm10 call GetLCDMask vpm12: srl a rr e jr nc,$F add a,80h $$: djnz vpm12 push af ld a,e call LCDDelay out (LCDdataPort),a call MySetLCDRow ld a,(curY) call LCDDelay out (LCDinstPort),a pop af call LCDDelay out (LCDdataPort),a ld hl,curXRow inc (hl) pop bc ld a,(hl) cp 0C0h jr nc,vpmReturn djnz vpm9 jr vpmReturn MySetLCDRow: push af ld a,(curXRow) call SetLCDRow call SetXAutoIncrementMode pop af ret GetLCDMask: bit textInverse,(iy+textFlags) jr z,$F ld b,a ld a,0FFh xor d or b jr vpm11 $$: and d vpm11: xor (ix+0) inc ix ld b,c ret vpmTable: DB 0FEh DB 0FCh DB 0F8h DB 0F0h DB 0E0h DB 0C0h