-
Notifications
You must be signed in to change notification settings - Fork 0
Expand file tree
/
Copy pathshow.subs
More file actions
1172 lines (1125 loc) · 27.8 KB
/
Copy pathshow.subs
File metadata and controls
1172 lines (1125 loc) · 27.8 KB
1
* ----- Show subroutines ----- *print pshs a,b,x,y ldy ,x++ lda wpath os9 I$Write stb retcode puls a,b,x,y,pcgetkey pshs a,b,x,y lda wpath leax ,s ldy #1 os9 I$Read stb retcode puls a,b,x,y,pcos9beep pshs a,b,x,y leax beepchar,pcr ldy #1 lda wpath os9 I$Write stb retcode puls a,b,x,y,pcmsgout pshs a,b,x,y ldy ,x++ lda #2 os9 I$Write stb retcode puls a,b,x,y,pcerrmout ldy ,x++ lda #2 os9 I$Writeerrout ldb retcode os9 F$Exiterrmexit ldy ,x++ lda #2 os9 I$Writeerrexit ifne testing clrb tfr b,dp endc leax selctstr,pcr ldy #2 lda #1 os9 I$Write ldx dbtaddr lda #datblksclrblks ldb ,x+ ldu ,x++ tstb beq doneclrb ldb #1 os9 F$ClrBlkdoneclrb deca bne clrblks ldx botofmem leay blksend,x sty systemp1 leay blkstrt,x clradelblks ldb ,y+ beq donedelb tfr d,x ldb #1 os9 F$DelRAMdonedelb cmpy systemp1 blo delblks ldb retcode os9 F$Exitmapblk pshs a,b,x clra tfr d,x ldb #1 lda ,s lbsr os9mpblk stb retcode bcs mapbquit ldx dbtaddr lda ,s lsla adda ,s Multiply A by 3 [ A * (2 + 1) = 2A + A ] ldb 1,s stb a,x inca stu a,xmapbquit puls a,b,x,pcclrblk pshs b,x,u ldx dbteaddrfindblk ldb ,x cmpb ,s beq foundblk leax -3,x cmpx dbtaddr blo cbdone bra findblkfoundblk clr ,x+ ldu ,x ldb #1 os9 F$ClrBlk stb retcodecbdone puls b,x,u,pcfreemem pshs b,x Free up all known areas ldx dbtaddrfmdoblok ldb ,x beq fmckdone bsr clrblkfmckdone leax 3,x cmpx dbteaddr bls fmdoblok puls b,x,pcmapscrn pshs a,b,x,y,u tst bgrndscr Are we running a background screen? lbne bgrndset tst scrnmapd No, is the screen already mapped in? lbeq getscrn ldx botofmem No leax winfo,x lda WI$Sty,x cmpa scrntype lbeq mapsquit Are the new and old screens the same? lbsr unmapscrgetscrn leax winfonam,pcr No, map gfx screen into workspace (via WINFO) lda #Sbrtn+Objct os9 F$Link Link to Winfo stb retcode bcc getwinam os9 F$Load Load if not in memory ldb #E$MNF stb retcode lbcs errexitgetwinam sty systemp2 stu linkhdr lda wpath ldx botofmem leax stack,x ldb #SS.DevNm os9 I$GetStt Get name of window for Winfo leay ,x clrbwnamsize lda ,x+ Get size of window name incb cmpa #$80 blo wnamsize clr ,x anda #%01111111 sta -1,x clra sts systemp1 ldy #WI$Size Set up parameters for Winfo pshs y ldu botofmem leax stack,u leay winfo,u pshs y pshs d pshs x ldd #2 pshs d jsr [systemp2,u] Call Winfo lds systemp1 lbcs errout ldu linkhdr os9 F$UnLink Unlink Winfo clr retcode ldy botofmem leay winfo,y leax winfoed,pcr ldb WI$Edtn,y cmpb #1 lblo errmexit ldb WI$Stat,y bne winfoerr ldb #183 Illegal Window Type (should NOT happen!) stb retcode lda WI$Sty,y cmpa #5 Proper window was not created for some reason! lblo errexit clra ldb WI$Block,y tfr d,x ldb WI$BlCnt,y lslb lslb lslb lslb lslb stb scrnmems Size of screen memory clr scrnmems+1 ldb WI$BlCnt,y lda #1 lbsr os9mpblk Map in the screen at block A (1) stb retcode bcs mapsquit stu scrnaddr inc scrnmapdmapsquit puls a,b,x,y,u,pcunmapscr pshs b,u tst scrnmapd beq umpsexit Is screen mapped in? ldu botofmem Yes leau winfo,u ldb WI$BlCnt,u ldu scrnaddr os9 F$ClrBlk stb retcode clr scrnaddr clr scrnaddr+1 clr scrnmapdumpsexit puls b,u,pcwinfoerr pshs b Come here if Winfo returned with error leax errormsg,pcr lbsr msgout Print "ERROR:" leax WI$ErMsg,y ldb #$0d std 40-1,x lda #2 ldy #40 os9 I$WritLn Output Winfo's error message puls b clr retcode lbra errexitbgrndset ldb #99 Not implemented stb retcode lbra errexitmoveblok pshs cc,a,b,x,y,u orcc #IntMasks Move 8k bytes from X to Y stb scrlcnt,pcr ldd #$0000 std $FF92 Stop ALL interrupts via the GIME chip sts systemp1 leau ,x leas 8,y Stack moves are fastest! tfr dp,b stb dpagehld,pcrdomovblk pulu cc,dp,a,b,x,y Move 8 bytes at one time (128 per iteration) pshs cc,dp,a,b,x,y leas 16,s (moved 8 so far) pulu cc,dp,a,b,x,y pshs cc,dp,a,b,x,y leas 16,s (moved 16 so far) pulu cc,dp,a,b,x,y pshs cc,dp,a,b,x,y leas 16,s (moved 24 so far) pulu cc,dp,a,b,x,y pshs cc,dp,a,b,x,y leas 16,s (moved 32 so far) pulu cc,dp,a,b,x,y pshs cc,dp,a,b,x,y leas 16,s (moved 40 so far) pulu cc,dp,a,b,x,y pshs cc,dp,a,b,x,y leas 16,s (moved 48 so far) pulu cc,dp,a,b,x,y pshs cc,dp,a,b,x,y leas 16,s (moved 56 so far) pulu cc,dp,a,b,x,y pshs cc,dp,a,b,x,y leas 16,s (moved 64 so far) pulu cc,dp,a,b,x,y pshs cc,dp,a,b,x,y leas 16,s (moved 72 so far) pulu cc,dp,a,b,x,y pshs cc,dp,a,b,x,y leas 16,s (moved 80 so far) pulu cc,dp,a,b,x,y pshs cc,dp,a,b,x,y leas 16,s (moved 88 so far) pulu cc,dp,a,b,x,y pshs cc,dp,a,b,x,y leas 16,s (moved 96 so far) pulu cc,dp,a,b,x,y pshs cc,dp,a,b,x,y leas 16,s (moved 104 so far) pulu cc,dp,a,b,x,y pshs cc,dp,a,b,x,y leas 16,s (moved 112 so far) pulu cc,dp,a,b,x,y pshs cc,dp,a,b,x,y leas 16,s (moved 120 so far) pulu cc,dp,a,b,x,y pshs cc,dp,a,b,x,y leas 16,s (moved 128 bytes) dec <scrlcnt,pcr bne domovblk (do again for next line) ldb <dpagehld,pcr tfr b,dp lds systemp1 lda $FFA9 clr $FFA9 Get OS-9's GIME shadow registers ldx $2092 stx $FF92 Restore ALL interrupts sta $FFA9 puls cc,a,b,x,y,u,pcdpagehld fcb 0scrlcnt fcb 0intrap rtigetparms pshs d,x Check for paramater under/overflow clr retcode leax psizmsg,pcr cmpd #$2000-stack+100 lbhs errmexit leax parmmsg,pcr cmpd #1 lbeq errmout ldb #56 Parameter error stb retcode clrb Read options from parm list puls x,ygpnextpm lda ,y+ leax -1,x lbeq errexit cmpa #32 beq gpnextpm cmpa #'- bne gpstorcc lda ,y+ leax -1,x lbeq errexit bra gpdecodegpnodash lda ,y+ leax -1,x lbeq errexit cmpa #32 beq gpnextpmgpdecode anda #%01011111 cmpa #'F Do full screen pictures? bne gpnotful orb #FullSize Yes bra gpnodashgpnotful cmpa #'S Do a slide show? bne gpnotsld inc slidshow Yes lda #defslidp sta paustime lda ,y cmpa #'0 Has a pause time been included? blo gpnodash cmpa #'9 bhi gpnodash pshs b tfr a,b subb #'0 Yes, check for additional digitsgpsldpse leay 1,y leax -1,x lbeq errexit lda ,y cmpa #'0 blo gpsldpsv cmpa #'9 bhi gpsldpsv suba #'0 pshs a lda #10 mul addb ,s+ bra gpsldpsegpsldpsv stb paustime Save new pause time puls b bra gpnodashgpnotsld cmpa #'P Don't do proporionalization? (for Hardcopy) bne gpnotprp orb #NoProp Yes bra gpnodashgpnotprp cmpa #'C Colorize (Aritifact) colors in BIN? bne gpnotclr orb #Colorize Yes bra gpnodashgpnotclr cmpa #'E Enhanced video mode? bne gpnotenh orb #Enhanced Yes bra gpnodashgpnotenh lbra errexit Unrecognized parametergpstorcc stb callcode leax 1,x leay -1,y pshs x,y lbsr allocblk Copy file list to separate ram block lbcs errexit lda #1 stb parmblk lbsr mapblk lbcs errexit tfr u,d anda #%00011111 std parmaddr lda #32 sta ,u+ puls x,ymoveparm lda ,y+ sta ,u+ leax -1,x bne moveparm ldb parmblk lbsr clrblk rtsmakescrn pshs x lda #Updat. leax winame,pcr os9 I$Open stb retcode lbcs errexit sta wpath puls x lbsr print lbcs errexit lda wpath ldb #SS.Mouse ldx #$ff01 os9 I$SetStt stb retcode lbcs errexitmsgetscr orcc #IntMasks bsr havescrn bne msgotscr andcc #^IntMasks ldx #6 os9 F$Sleep bra msgetscrmsgotscr ldx blk0addr ldd $1020,x $1020 = CC.WDMem std myscreen andcc #^IntMasks lda wpath ldb #SS.Mouse ldx #0 os9 I$SetStt stb retcode lbcs errexit rtshavescrn pshs cc,a,b,x ldx botofmem leax mousepak,x lda wpath ldb #SS.Mouse os9 I$GetStt puls cc tst Pt.Valid,x puls a,b,x,pcopenfile ldb parmblk lda #maxmapbk+1 lbsr mapblk lbcs errexit ldd parmaddr leax d,usrchspc lda ,x+ cmpa #13 beq weredone cmpa #32 bne srchspcskipspc lda ,x+ cmpa #32 beq skipspc cmpa #13 bne dopenfilweredone lda error Finished all parameters, so exit with sta retcode any important errors. lbra errexitdopenfil leax -1,x pshs x lda #Read. os9 I$Open stb retcode pshs cc,a leax -1,x tfr x,d adcb #0 adca #0 anda #%00011111 std parmaddr puls cc,a,x bcs ofilout2 sta filepath ldy #0ofilfnd. lda ,x+ cmpa #32 beq ofbadnam cmpa #13 beq ofbadnam cmpa #'. bne ofilfnd. leay ,x bra ofilfnd.ofbadnam cmpy #0 bne showext lda #E$BNam sta retcode orcc #Carry bra ofilout2showext ldu botofmem leax linkname+4,u ldd ,y++ std ,x++ lda ,y sta ,xofilout2 pshs cc ldb retcode pshs b ldb parmblk lbsr clrblk puls b stb retcode puls ccofileout rtslinkshow ldu botofmem ldb #E$MNF stb retcode leax linkname,u lda #Sbrtn+Objct os9 F$Link sty showexec stu showhdr bcc lshowrev os9 F$Load sty showexec stu showhdr bcs lshowoutlshowrev andb #$0f cmpb #Revision beq lshowout ldb #E$BMID stb retcode os9 F$UnLink comblshowout rtscallshow pshs dp ldu showhdr ldd M$Mem,u cmpd #submemsz bls setcallr lda #E$IForkP sta retcode orcc #Carry puls dp,pcsetcallr ldu botofmem leau submem,u ldd showexec std ,u lda filepath ldb callcode ldx scrnaddr bne setcally lbsr mapscrn ldx scrnaddrsetcally ldy #grflines Maximum number of lines per single screen pshs u puls dp leas 1,s jsr [,u] puls dp stb retcode andcc #^IntMasks rtscleanup ldu showhdr os9 F$UnLink lda filepath os9 I$Close lbsr freemem rtsmemsetup clr bgrndscr lbsr freemem lbsr mapscrn rtspause tst slidshow bne pausekey lbsr os9beeppausekey lda wpath ldb #$01 $01 = SS.Rdy os9 I$GetStt bcs pausekck lbsr getkey Grab all pending keys bra pausekeypausekck lda #paustime ldb #pausmult mul addd #pausedec std sleepcnt clr ,-spmflgetk lda wpath ldb #$01 $01 = SS.Rdy os9 I$GetStt bcs pmfltsts lbsr getkey cmpa #$0C <Up-Arrow> doesn't count beq pmflwait cmpa #$0A Neither does <Down-Arrow> beq pmflwait sta ,s bra pauseky2pmfltsts ldx blk0addr ldd myscreen cmpd $1020,x $1020 = CC.WDMem bne pmflslep lda scrnflip deca bne pmflwaitpmflslep ldx #pausedec os9 F$Sleep bra pmflslidpmflwait cwai #^IntMasks Wait for interupt lbsr irqflippmflslid tst slidshow lbeq pmflgetk ldd sleepcnt subd #pausedec beq pauseky2 std sleepcnt lbra pmflgetkpauseky2 lda wpath ldb #$01 $01 = SS.Rdy os9 I$GetStt bcs pausempl lbsr getkey Get all keys in buffer sta ,s lda wpath bra pauseky2pausempl puls a,pcflipirqs pshs cc,a,b,x,y orcc #IntMasks ldy irqvectr ldb ,y stb oldirqin lda #jmpinst sta ,y+ ldx ,y stx oldirqvc leax irqscrn,pcr stx ,y ldy swivectr ldb ,y stb oldswiin sta ,y+ ldx ,y stx oldswivc leax swiscrn,pcr stx ,y puls cc,a,b,x,y,pcflipirqr pshs cc,a,x,y orcc #IntMasks ldy irqvectr lda oldirqin sta ,y+ ldx oldirqvc stx ,y ldy swivectr lda oldswiin sta ,y+ ldx oldswivc stx ,y puls cc,a,x,y,pcswiscrn ldu swivectr clrb tfr b,dp bra irqcallirqscrn ldx blk0addr clrb tfr b,dp ldu irqvectr ldd myscreen cmpd $1020,x $1020 = CC.WDMem lbne irqcall* tst paletmod* lbsr rotpalet* bsr irqflipirqcall bsr flipirqr stu irqcalla*ldb #R$PC*os9 F$PErr*tfr s,d*exg a,b*os9 F$PErr*tfr a,b*os9 F$PErr*ldx #0*os9 F$Sleep ldx R$PC,s stx irqretad leax irqretrn,pcr stx R$PC,s puls cc,a,b,dp,x,y,u Restore old registers pshs cc,a,b,dp,x,y,u orcc #IntMasks jmp [>irqcalla] Call original IRQ service routineirqretrn lbsr flipirqs jmp [>irqretad]irqflip inc crntfscr ldb crntfscr cmpb scrnflip blo irqload clrb stb crntfscrirqload ldu botofmem leay ramblock,u lda picblks mul lda b,y lsla lsla clrb pshs d ldb crntfscr leay bdrpalet,u lda b,y pshs a leay palette,u lda #16 mul leay d,y ldd ,y++ Update palette std $ffb0+$0 ldd ,y++ std $ffb0+$2 ldd ,y++ std $fbb0+$4 ldd ,y++ std $ffb0+$6 ldd ,y++ std $ffb0+$8 ldd ,y++ std $ffb0+$a ldd ,y++ std $ffb0+$c ldd ,y std $ffb0+$e puls a,x stx $ff9d Update screen start address sta $ff9a Update border coloriflipdon rtsallocblk ldb #1 os9 F$AllRAM stb retcode rtsmul16x16 pshs d leas -8,s stx ,s sty $2,s ldd #$0000 std 4,s std 6,s lda 1,s ldb 3,s mul std 6,s lda 1,s ldb 2,s mul addd 5,s std 5,s bcc m16x16a inc 4,sm16x16a lda ,s ldb 3,s mul addd 5,s std 5,s bcc m16x16b inc 4,sm16x16b lda ,s ldb 2,s mul addd 4,s tfr d,x ldy 6,s leas 8,s puls d,pcsetpalet pshs a,b,x,y,u stb bordrpal lda scrnflip lsla lsla Multiply by 16 lsla lsla ldu botofmem leau palette,u pshs xspcpypal ldb ,x+ stb ,u+ deca bne spcpypal ldu botofmem leau bdrpalet,u lda scrnflipspcpybdr ldb ,x+ stb ,u+ deca bne spcpybdr puls xspsetup leau ,x leas -4,s ldx #$1b31 stx ,s clr 2,s ldd #$003f Foreground/Background (init opposite) std whitepal ( White ) ( Black ) leax ,s ldy #4 lda wpath ldb scrnclrs stb systemp1dosetpal ldb ,u+ stb 3,schekbpal cmpb blackpal bhs chekwpal stb blackpalchekwpal cmpb whitepal bls dospwrit stb whitepaldospwrit os9 I$Write inc 2,s dec systemp1 bne dosetpal ldb #$34 stb 1,s ldb bordrpal Retrieve border color stb 2,s ldy #3 os9 I$Write leas 4,s puls a,b,x,y,u,pcsetforbk pshs a,b,x,y leas -6,s ldd #$1b32 std ,s ldb whitepal stb 2,s ldb #$33 std 3,s ldb blackpal stb 5,s lda wpath leax ,s ldy #6 os9 I$Write leas 6,s puls a,b,x,y,pcsetowin pshs a,b,x,y leas -9,s ldd #$1b22 stb ,s ldb #1 stb 2,s ldy botofmem leay winfo,y ldd WI$Szx,y subd 9,s Width & Height subd #$0404 lsra lsrb std 3,s ldd 9,s Width & Height addd #$0404 std 5,s ldd whitepal Background and Foreground colors std 7,s lda wpath leax ,s ldy #9 os9 I$Write stb retcode bcs sowfinsh bsr setforbk ldb #$25 stb 1,s ldd #$0101 std 2,s ldd 5,s subd #$0202 std 4,s ldb #12 Clear the new area stb 6,s lda wpath ldy #7 os9 I$Write ldd #$0202 std 2,s ldd 4,s subd #$0202 lda wpath os9 I$Writesowfinsh leas 9,s puls a,b,x,y,pcechon pshs a,b,x lda wpath ldb #SS.OPT ldx botofmem leax optbufr,x os9 I$GetStt clr $4,x inc $4,x os9 I$SetStt stb retcode puls a,b,x,pcechoff pshs a,b,x lda wpath ldb #SS.OPT ldx botofmem leax optbufr,x os9 I$GetStt clr $4,x os9 I$SetStt stb retcode puls a,b,x,pcsetscrn pshs a,b,x,y clr systemp1 ldy botofmem leay winfo,y lda scrntype cmpa WI$Sty,y beq sscrexit lbsr unmapscr Unmap the screen from the address space leas -16,s ldd #$1b24 DWEnd -- Erase old window std ,s ldd #$1b20 DWSet -- Create new window std 2,s ldb scrntype New window screen type stb 4,s ldd #$0000 Start coordinate of window (0,0) std 5,s ldd scrnxsiz Screen width (num pixels/8) columns lsra rorb lsra rorb lsra rorb stb 7,s ldb #grftext Screen height (24/25) lines stb 8,s ldd #$0000 Foreground, Background, & Border colors std 9,s sta 11,s ldd #$0520 Turn the cursor off std 12,s ldd #$1b21 Select the window as active std 14,s lda wpath leax ,s ldy #16 os9 I$Write Send the codes to the screen stb retcode leas 16,s bcs sscrexit lbsr mapscrn Map the new screen in and get its infosscrexit puls a,b,x,y,pcmemscrn pshs a,b,x,y,u lbsr freemem lbsr mapscrn lbsr unmapscrmemextra ldu botofmem leax ramblock,u clrb tst bgrndscr Are we loading into a background screen? bne msclrall ldb WI$BlCnt+winfo,u Nomsclrall stx rambkptr stb rambkcnt sts stackhldmsmapblk ldb rambkcnt cmpb picblks bhs msclrscr inc rambkcnt clra ldx rambkptr ldb b,x tfr d,x ldb #1 os9 F$MapBlk stu systemp1 ifne testing bcc msprepmv lds stackhld ldb #99 stb retcode lbra errexit endcmsprepmv ldb #5 orcc #IntMasks Disable interupts for stack clear leas zeros,pcr puls a,b,x,y,u Zero all registers lds systemp1 leas $2000,smsdomove pshs a,b,x,y,u pshs a,b,x,y,u pshs a,b,x,y,u pshs a,b,x,y,u pshs a,b,x,y,u pshs a,b,x,y,u pshs a,b,x,y,u pshs a,b,x,y,u pshs a,b,x,y,u pshs a,b,x,y,u pshs a,b,x,y,u pshs a,b,x,y,u pshs a,b,x,y,u pshs a,b,x,y,u pshs a,b,x,y,u pshs a,b,x,y,u cmps systemp1 bhi msdomove ldu systemp1 lds stackhld andcc #^IntMasks ldb #1 os9 F$ClrBlk bra msmapblkmsclrscr tst bgrndscr Are we loading into a background screen bne msdonclr lbsr mapscrn No ldu botofmem leay winfo,u lda WI$BlCnt,y clrb lsla lsla lsla lsla lsla addd scrnaddr std systemp1 sts stackhld orcc #IntMasks leas zeros,pcr puls a,b,x,y,u lds systemp1clrscrn pshs a,b,x,y,u pshs a,b,x,y,u pshs a,b,x,y,u pshs a,b,x,y,u pshs a,b,x,y,u pshs a,b,x,y,u pshs a,b,x,y,u pshs a,b,x,y,u pshs a,b,x,y,u pshs a,b,x,y,u pshs a,b,x,y,u pshs a,b,x,y,u pshs a,b,x,y,u pshs a,b,x,y,u pshs a,b,x,y,u pshs a,b,x,y,u cmps scrnaddr bhi clrscrn lds stackhld andcc #^IntMasksmsdonclr puls a,b,x,y,u,pcos9mpblk pshs a,x B contains block to map in clr systemp2+1 A contains area to map it into stb systemp2 ldx #0 ldb #1 os9 F$MapBlk Map in test block bcs os9mbout os9 F$ClrBlk We're finished with it, so get rid of it tfr u,d lsra lsra What area was test block mapped into lsra lsra lsra inca suba ,s suba systemp2 sta systemp2+1 How many blocks to map in on temp basis so that bmi os9mbfit our block goes where we want it beq os9dompb tfr a,b If no blocks needed, come here, else go elsewhere os9 F$MapBlk bcs os9mbout stu systemp1os9dompb ldb systemp2 ldx 1,s os9 F$MapBlk Map in our block ifne testing bcc os9mbusp pshs b Hmmm... Shouldn't reach here. Report error ldb #99 os9 F$PErr puls b stb retcode lbra errexit endcos9mbusp ldb systemp2+1 Did we map in any other temp blocks? beq os9mbout pshs u Yes ldu systemp1 os9 F$ClrBlk Unmap them puls uos9mbout puls a,x,pc Returnos9mbfit ldb #E$BPAddr Bad Page Address stb retcode orcc #Carry bra os9mboutcopyscrn lbsr freemem lbsr mapscrn ldu botofmem leay ramblock,u leax winfo,u lda WI$BlCnt,xcsscpblk tsta beq csreturn deca pshs a,y ldb a,y clra tfr d,x ldb #1 os9 F$MapBlk stb retcode bcs cserror1 leay ,u lda ,s lsla lsla lsla lsla lsla clrb addd scrnaddr tfr d,x ldb #($2000/128) lbsr moveblok Copy screen to reserved block ldb #1 os9 F$ClrBlk puls a,y bra csscpblk Do next screen blockcserror1 leas 3,scsreturn rts