; ÐÉÃÐÁÓÔÅ by Harold Long, 1985›;›; Global section››; Defines:›DEFINE true="1"›DEFINE false="0"›DEFINE sswap="0"       ;which of three routines›DEFINE scut="1"        ;are we doing...›DEFINE spaste="2"››; Parameter list for paste routine›; "ToBCol" & "ToBRow" are redundant but›; needed so we can 'flip' the list and›; move things back and forth.›BYTE POINTER   FrScr           ;"From Screen"›BYTE           FrTCol          ;top col›BYTE           FrTRow          ;top row›BYTE           FrBCol          ;bottom col›BYTE           FrBRow          ;bottom row›BYTE POINTER   ToScr           ;"To Screen"›BYTE           ToTCol          ;top col›BYTE           ToTRow          ;top row›BYTE           ToBCol          ;bottom col›BYTE           ToBRow          ;bottom row››BYTE SDMCTL=$22F, DINDEX=$57, RAMTOP=$6A›CARD SDLSTL=$230, SAVMSC=$58››BYTE ARRAY PMHshd(8)=[0 0 0 0 0 0 0 0] ;shadow regs for $D000››BYTE key=764›BYTE cpbuf=[0]       ;active cut/paste buffer›CARD scrn1,scrn2,scrn3     ;pointers to alternate screens›BYTE scrno           ;active screen #›CARD MEMLO=$743, codebase=$491,›     codesize=$493, size, INITAD=$2E2›BYTE ARRAY colpf(0)=$2C4 ›BYTE ARRAY colsv(20)›CARD dsl1, dsl2, dsl3, text, lastgr, textm››BYTE ARRAY fname(18)           ;file name+ext›BYTE ARRAY file1(18),file2(18) ›BYTE ARRAY str132(18)››BYTE POINTER ptr›BYTE ARRAY buf(19)›BYTE ARRAY Dir_string(960)››BYTE ARRAY foo(3)›BYTE ARRAY i(2),j(2),pi(4),pj(4), cp(4)›BYTE ti,tj›BYTE ARRAY cmd(5)›BYTE ic                        ;input command char››; Save one of three screen's color reg's›PROC SvCol(BYTE n) ; n=0:2›BYTE I›FOR I=0 TO 4›DO› colsv(I+n*5)=colpf(I)›OD›RETURN››; Force cut/paste to last display›PROC CPcol()›BYTE I›FOR I=0 TO 4›DO› colsv(I+15)=colpf(I)›OD›RETURN››; Restore color reg's›PROC RsCol(BYTE n)›BYTE I›FOR I=0 TO 4›DO› colpf(I)=colsv(I+n*5)›OD›RETURN››; Swaps memory blocks of equal size›; Copyright (c) Harold Long, 1984›; See ACS "MoveBlock" for documentation›;PROC SwapBlock=*(BYTE POINTER a,b,CARD sz)›;[$A085$A186$A284$A0$0$A5A5$22F0›;$A2B1$AA$A0B1$A291$8A$A091$C8$F3D0›;$A1E6$A3E6$A5C6$EBD0$0BF0›;$A2B1$AA$A0B1$A291$8A$A091$C8›;$A4C4$F1D0$60]››; READPIC - Reads MicroIllustrator›; picture files.  Original code by›; Robert E. Wilson, REW Consulting.›;›; Modified for Action! and converted›; to code blocks by Harold Long,›; Bolton, MA. 14-Jan-1985›;›PROC GetByt=*() [›;Provides CCIO and bailout functions›$A5$AA$C5$AC$D0$06$A5$A9$C5$AB$F0$16 ›$A2$10$A9$00$8D$58$03$8D$59$03$20$56 ›$E4$30$09$E6$A9$D0$02$E6$AA$60$A9$01 ›$85$A0$68$68$60]›;Provides screen address calculation›PROC NxtPnt=*() [$24$A2$50$2C$C6$A5$F0 ›$0E$A9$50$18$65$A3$85$A3$A9$00$65$A4 ›$85$A4$60$A9$60$85$A5$C6$A6$F0$0E$A9 ›$28$18$65$AD$85$A3$A9$00$65$AE$85$A4 ›$60$A9$02$85$A6$A9$01$18$65$AD$85$AD ›$85$A3$A9$00$65$AE$85$AE$85$A4$60]››;›BYTE FUNC ReadPic=*() [›; Segment contains 181 bytes.›$A5$58$85$AD$85$A3$A5$59$85$AE$85$A4 ›$A9$60$85$A5$A9$02$85$A6$A9$07$8D$52 ›$03$A9$A0$8D$54$03$A9$00$8D$55$03$85 ›$A7$85$AC$A9$FF$85$AB$85$A9$85$AA$20 ›GetByt$85$A0$A5$A9$C9$07$F0$0A$C9$0C ›$F0$10$C9$1A$F0$2B$D0$EB$A5$A0$4A$6A ›$6A$85$A2$18$90$E1$A9$05$85$A1$20GetByt›$A6$A7$9D$C4$02$E6$A7$C6$A1$D0$F2 ›$20GetByt$85$AB$20GetByt$85$AC$18$90 ›$C2$A5$A2$F0$24$20GetByt$85$A1$29$7F ›$D0$0F$20GetByt$85$A8$E6$A8$20GetByt ›$85$A7$18$90$06$85$A7$A9$01$85$A8$A5 ›$A1$29$80$85$A1$20GetByt$85$A0$A0$00 ›$A5$A0$91$A3$20NxtPnt$A5$A2$F0$EE$C6 ›$A7$D0$04$C6$A8$F0$C2$A5$A1$F0$E9$D0 ›$E0]››PROC End=*()›[$68$AA$68$CD$2E8$90$5$CD$2E6$90$F3›$48$8A$48$60]››MODULE ; BLKIO.ACT››BYTE CIO_status››CHAR FUNC CIO=*(BYTE dev, CARD addr,›          size, BYTE cmd, aux1, aux2)›[$29$F$85$A0$86$A1$A$A$A$A$AA$A5$A5›$9D$342$A5$A3$9D$348$A5$A4$9D$349›$A5$A6$F0$8$9D$34A$A5$A7$9D$34B$98›$9D$345$A5$A1$9D$344$20$E456›$8C CIO_status$C0$88$D0$6$98$A4$A0›$99 EOF$60]››PROC WriteBlock=*(BYTE dev,›                    CARD addr, size)›; Writes size bytes from addr to dev.›; Status is saved in CIO_status.›[$48$A9$B$85$A5$A9$0$85$A6$A5$A3$5$A4›$D0$2$68$60$68$4C CIO]››MODULE››BYTE PM_Mode=[0],›     PMHitClr=$D01D››CARD PM_BaseAdr››BYTE ARRAY›      PMHpos(8)=$D000,›      PMVpos(8)=[0 0 0 0 0 0 0 0],›      PM_MisMask(4)=[$FC $F3 $CF $3F],›      PM_Width(5)=$D008›››CARD ARRAY›      PM_BSize=[0 $100 $80],›      PM_Waste=[0 768 384]››;************************************››PROC PMGraphics(BYTE mode)››  BYTE DMACtl=$22F,   ;P/M enable loc.›       Priority=$26F,›       GRACtl=$D01D,›       PMBase=$D407,›       GraphP0=$D00D››  CARD HiMem=$2E5,›       OldHiMem,›       AppMHi=$E››  CARD ARRAY PM_AdrMask=[0 $F800 $FC00],›             PM_MemSize=[0 $800 $400]››  mode==MOD 3›  Zero(PMHpos,8)  ; move them off the screen›  Zero(PMVpos,8)›  Zero(PM_Width,5)›  Zero(GraphP0,5)›  IF PM_Mode#0 THEN›    HiMem = OldHiMem›    DMACtl=$22›    GRACtl=0›  FI›  IF mode=0 THEN   ; turn off pmg›    DMACtl=$22›    GRACtl=0›  ELSE›    IF mode=1 THEN ;sgl line›      DMACtl=$3E›    ELSE           ;dbl line›      DMACtl=$2E›    FI›    OldHiMem=HiMem›    PM_BaseAdr=(HiMem-PM_MemSize(mode)-$80)&PM_AdrMask(mode)›    PMBase=PM_BaseAdr RSH 8›    IF PM_BaseAdr<AppMHi THEN›      DMACtl=$22›      GRACtl=0›      RETURN›    FI›    HiMem=PM_BaseAdr+PM_Waste(mode)›    Priority==& $C0 % 1›    GRACtl=3›  FI›  PM_Mode = mode   ; save mode›RETURN››;************************************››PROC PMColor(BYTE n,hue,lum)››  BYTE ARRAY PM_Color(4)=$2C0››  n==&3›  PM_Color(n)=(hue LSH 4) % (lum & $0F)›RETURN››;************************************››CARD FUNC PMAdr(BYTE n)››  n==&7›  IF n>=4 THEN›    n=0›  ELSE›    n==+1›  FI›RETURN(PM_BaseAdr+PM_Waste(PM_Mode)+(n*PM_BSize(PM_Mode)))››;************************************››PROC PMClear(BYTE n)››  CARD ctr››  BYTE ARRAY PlayAdr››  n==&7›  PlayAdr = PMAdr(n)›  IF n<4 THEN›    Zero(PlayAdr,PM_BSize(PM_Mode))›  ELSE›    n==-4›    FOR ctr=0 TO PM_BSize(PM_Mode)-1›      DO›      PlayAdr(ctr)==&PM_MisMask(n)›      OD›  FI›RETURN››;************************************››PROC PMMove(BYTE n,x INT y); change y for rel. move››  CARD i››  BYTE yOffset,›       plLength,›       mask1,mask2››  INT deltaY››  BYTE ARRAY temp(256),PlPtr››  IF PM_Mode=0 THEN›    RETURN›  FI›  n==&7›  deltaY=y-PMVpos(n)›  IF deltaY=0 THEN›    PMHpos(n)=x ;do horizontal anyway›  FI›  PlPtr=PMAdr(n)›  plLength=PM_BSize(PM_Mode)›  IF deltaY>=0 THEN›    yOffset=deltaY›  ELSE›    yOffset=plLength+deltaY›  FI›  IF n<4 THEN›    mask1=255›    mask2=0›  ELSE›    mask2=PM_MisMask(n&3)›    mask1=mask2!$FF›  FI››;**This piece of code was replaced by›;**the following code block to›;**increase speed.›; FOR i=0 to plLength-1›;  DO›;   temp(i)=PlPtr(i)&mask1›;  OD››[ $A0 0        ; LDY #0›  $AD PlPtr    ; LDA PLPTR›  $85 $A0      ; STA $A0›  $AD PlPtr+1  ; LDA PLPTR+1›  $85 $A1      ; STA $A1›;LOOP›  $B1 $A0      ; LDA ($A0),Y›  $2D mask1    ; AND MASK1›  $99 temp     ; STA TEMP,Y›  $C8          ; INY›  $CC plLength ; CPY PLLENGTH›  $D0 $F2      ; BNE LOOP›]››;**This piece of code was replaced by›;**the following code block to›;**increase speed.›; FOR i=0 to plLength-1›;  DO›;   PlPtr(yOffset)==&mask2 %temp(i)›;   yOffset==+1›;   IF yOffset>=plLength THEN›;     yOffset=0›;   FI›;  OD››[ $A2 0        ; LDX #0›  $AC yOffset  ; LDY YOFFSET›  $AD PlPtr    ; LDA PLPTR›  $85 $A0      ; STA $A0›  $AD PlPtr+1  ; LDA PLPTR+1›  $85 $A1      ; STA $A1›;LOOP›  $B1 $A0      ; LDA ($A0),Y›  $2D mask2    ; AND MASK2›  $1D temp     ; ORA TEMP,X›  $91 $A0      ; STA ($A0),Y›  $C8          ; INY›  $CC plLength ; CPY PLLENGTH›  $D0 2        ; BNE ISLOW›  $A0 0        ; LDY #0›;ISLOW›  $E8          ; INX›  $EC plLength ; CPX PLLENGTH›  $D0 $E8      ; BNE LOOP›]››  PMVpos(n)=y›  PMHpos(n)=x›  PMHshd(n)=x›RETURN››; Convert ATASCII to P/M graphics›PROC Plot_Chr(BYTE chr, BYTE POINTER pm)›BYTE   I›BYTE   POINTER ADDR›CARD   STARTLIST›       STARTLIST = Peek(756)*256›       IF     chr >= 32 AND chr <= 95  THEN ADDR=((chr-32)*8+STARTLIST) ›       ELSEIF chr >=  0 AND chr <= 31  THEN ADDR=((chr+64)*8+STARTLIST) ›       ELSEIF chr >= 96 AND chr <= 127 THEN ADDR=(chr*8+STARTLIST)›       FI›       FOR I = 0 TO 7›       DO›        pm(I)=ADDR^›        ADDR==+1›       OD›RETURN››PROC setup_pm() ›  BYTE ctr,x        ›  BYTE ARRAY p0,p1,p2,p3›  PMGraphics(1)›  p0=PMAdr(0)›  p1=PMAdr(1)›  p2=PMAdr(2)›  p3=PMAdr(3)›  FOR ctr=0 TO 7›  DO›   PMClear(ctr)›  OD›  Plot_Chr('1,p0)›  PMColor(0,3,8)›  Plot_Chr('2,p1)›  PMColor(1,3,8)›  Plot_Chr('+,p2)›  PMColor(2,5,8)›  Plot_Chr('+,p3)›  PMColor(3,7,8)›RETURN››PROC MoveLine(BYTE POINTER front, back, BYTE width, fcol, tcol, mode)›CARD FrByte, ToByte›BYTE ctr, FrBit, ToBit, ftemp, ttemp, fmask, tmask›BYTE mfbyte, mtbyte›FOR ctr=0 TO width ; pixel count, not BYTES!›DO› FrByte=(fcol+ctr) RSH 2› ToByte=(tcol+ctr) RSH 2› FrBit=(fcol+ctr) - (FrByte LSH 2)› ToBit=(tcol+ctr) - (ToByte LSH 2)› FrByte==+front› ToByte==+back› IF FrBit=0 THEN›  ftemp=Peek(FrByte) & $C0›  fmask=Peek(FrByte) & $3F› ELSEIF FrBit=1 THEN›  ftemp=Peek(FrByte) & $30›  fmask=Peek(FrByte) & $CF› ELSEIF FrBit=2 THEN›  ftemp=Peek(FrByte) & $0C›  fmask=Peek(FrByte) & $F3› ELSEIF FrBit=3 THEN›  ftemp=Peek(FrByte) & $03›  fmask=Peek(FrByte) & $FC› FI› IF mode=sswap OR mode=scut THEN›  Poke(FrByte,fmask)› FI› IF ToBit=0 THEN›  ttemp=Peek(ToByte) & $C0›  tmask=Peek(ToByte) & $3F› ELSEIF ToBit=1 THEN›  ttemp=Peek(ToByte) & $30›  tmask=Peek(ToByte) & $CF› ELSEIF ToBit=2 THEN›  ttemp=Peek(ToByte) & $0C›  tmask=Peek(ToByte) & $F3› ELSEIF ToBit=3 THEN›  ttemp=Peek(ToByte) & $03›  tmask=Peek(ToByte) & $FC› FI› Poke(ToByte,tmask)› ftemp=ftemp LSH (FrBit LSH 1) RSH (ToBit LSH 1)› ttemp=ttemp LSH (ToBit LSH 1) RSH (FrBit LSH 1)› fmask=fmask % ttemp› tmask=tmask % ftemp› IF mode=sswap OR mode=scut THEN›  Poke(FrByte, fmask)› FI› Poke(ToByte, tmask)›OD›RETURN››PROC paste(BYTE mode)›BYTE POINTER front, back›BYTE width,height,I›  width=FrBCol-FrTCol            ;width of block›  WHILE (width+ToTCol>159) OR (width+FrTCol>159)›  DO›   width==-1›  OD›  height=FrBRow-FrTRow           ;height of block›  WHILE (height+ToTRow>191) OR (height+FrTRow>191)›  DO›   height==-1›  OD›  front=FrScr+40*FrTRow           ;assumes graphics 4,5,D,E, or F.›  back=ToScr+40*ToTRow          ;e.g., 40 bytes per scan line›  FOR I=1 TO height›  DO›   back==+40                     ;bump a scan line›   front==+40                    ;and continue move›   MoveLine(front,back,width,FrTCol, ToTCol, mode)›  OD›RETURN››; synchronization routine, used to prevent›; partial overlays when rapidly flipping paste›PROC sync()›; Provides vertical synchronization›BYTE clk=$14, clk1›clk1=clk›DO› UNTIL clk1 # clk›OD›RETURN  ››; Build an ANTIC-E mode display list›; for the 400/800 owners›CARD FUNC Antic_E()›BYTE   temp›CARD   change›  Graphics (8+16)         ;need GR 8 size memory›  temp=SDMCTL             ;save display control reg›  SDMCTL=0                ;turn off display›  Poke (SDLSTL+3,78)      ;force the first LMS›  FOR change=(SDLSTL+6) TO (SDLSTL+204) ;we know how long mode 8 is›    DO›      IF Peek(change)=15 THEN›        Poke (change, 14)›      ELSEIF Peek(change)=79 THEN›        Poke (change, 78)›      FI›    OD›  DINDEX=7                ;fool OS to think it's mode 7›  SDMCTL=temp             ;turn screen back on›RETURN(SDLSTL)            ;where the display list is...››; full-screen flip routine; switches display list›; from current to the one at "dislst"›PROC PageFlip(BYTE n)›CARD templst,dislst›BYTE sdmtmp›IF n=0 THEN› dislst=dsl1›ELSEIF n=1 THEN› dislst=dsl2›ELSEIF n=2 THEN                ;text buffer› dislst=text                     ›ELSEIF n=3 THEN                ;cut/paste buffer› dislst=dsl3›FI›templst=PeekC(SDLSTL+200)›sdmtmp=SDMCTL                  ;get screen ctl›SDMCTL=0                       ;turn off screen›PokeC(SDLSTL+200,dislst)›SDMCTL=sdmtmp›sync()›RsCol(n)›PokeC(SDLSTL+200,templst)›SDLSTL=dislst›RETURN››; turn on text screen›PROC texton()›IF DINDEX=0 THEN               ;skip if we are› RETURN                        ;already GR 0›FI›SAVMSC=textm›lastgr=SDLSTL›DINDEX=0›PageFlip(2)                 ;easy!›RETURN››; turn off text screen and go back to›; last graphics screen›PROC textoff()›CARD templst›BYTE sdmtmp›templst=PeekC(SDLSTL+30)›sdmtmp=SDMCTL›SDMCTL=0›PokeC(SDLSTL+30,lastgr)›DINDEX=7›SDMCTL=sdmtmp›sync()›PokeC(SDLSTL+30,templst)›SDLSTL=lastgr›IF lastgr=dsl1 THEN› RsCol(0)›ELSE› RsCol(1)›FI›RETURN››PROC stat()›CARD himem=$E›Print("Player/missles start at ")›PrintCE(PM_BaseAdr)›Print("Object code ends at ")›IF cpbuf THEN› PrintCE(INITAD+15)›ELSE› PrintCE(himem)›FI›RETURN››; sets up two (or three) complete GR 15 display›; screens, plus a GR 0 text screen,›; plus single-width player/missle›; area. (Whew!)›;›PROC screens()›PMGraphics(0)›dsl1=Antic_E()                 ;start of display list›scrn1=SAVMSC                   ;start of screen memory›RAMTOP==-$20                   ;subtract 8K›dsl2=Antic_E()                 ;start of display list›scrn2=SAVMSC                   ;start of screen mem›RAMTOP==-$20›IF RAMTOP > $79 THEN     ;48K and no cartridge!› dsl3=Antic_E()› scrn3=SAVMSC› RAMTOP==-$20› cpbuf=true›ELSE› dsl3=dsl2› scrn3=scrn2› cpbuf=false›FI›Graphics(0)›SvCol(2)                       ;standard colors›text=SDLSTL                    ;SDLSTL›textm=SAVMSC›setup_pm()›RAMTOP==+$40                   ;fix pointer›IF cpbuf THEN› RAMTOP==+$20›FI›lastgr=dsl1                    ;init last GR pointer›RETURN››; Pause for a keystroke›BYTE FUNC pause()›BYTE stroke›DO› stroke=key› UNTIL stroke # 255›OD›key=255›RETURN(stroke)››;clear entire text area›PROC fullflush()›BYTE POINTER foo›foo=SAVMSC›SetBlock(foo,960,0)›RETURN››; Flush the working text area›PROC flush()›BYTE POINTER foo›foo=SAVMSC›foo=foo+280›SetBlock(foo,680,0)›RETURN››;Present a help screen›PROC help()›PutE()›PrintE("         Editing Commands")›PutE()›PrintE("Left button positions cursor/ident")›PutE()›PrintE("'1' flips to screen one")›PrintE("'2' flips to screen two")›IF cpbuf THEN› PrintE("'3' flips to cut/paste buffer")›FI›PrintE("'C' cuts indicated area to buffer")›PrintE("'P' pastes indicated area from buffer")›PrintE("'S' swaps areas between screens")›PrintE("'F' mirror reverses current screen")›PrintE("'I' unfreezes screen ident number")›PrintE("'L' unfreezes lower cursor")›PrintE("'U' unfreezes upper cursor")›PrintE("'M' returns to command menu")›Printe("'Z' erases current screen")›PutE()›PrintE("Press any key to exit screen.")›pause()›fullflush()                    ;clean up our act›RETURN››;Present an announcement page and›;sign-on banner.›PROC banner()›PutE()›PutE()›PrintE("ÐÉÃÐÁÓÔÅ - MicroIlustrator Picture")›PrintE("cut & paste editor.  Copyright (c)")›PrintE("1985, Harold Long, Bolton, MA.")›PrintE("Permission granted to distribute")›PrintE("for non-commercial purposes.")›PutE()›PrintE("Koala Pad (tm) or paddle controlers")›PrintE("required.  See Help screen for info.")›PutE()›PrintE("Press any key to exit screen.")›PutE()›pause()›fullflush()                    ;clean up our act›RETURN››BYTE FUNC IsLower(BYTE ct)››   IF (ct>='a) AND (ct<='z) THEN›      RETURN(1)›   FI›RETURN(0)››BYTE FUNC ToUpper(BYTE ct)››   IF IsLower(ct) THEN›      ct ==-$20›   FI›RETURN(ct)››PROC Test_Name(BYTE POINTER fname)›  BYTE chr, cnt, ext›  chr=0›  ext=0›  FOR cnt=1 TO fname(0) DO›    fname(cnt)=ToUpper(fname(cnt))›    IF fname(cnt)='. THEN ext=cnt FI›    IF fname(cnt)=': THEN chr=1 FI›  OD›  IF (ext>0) AND (ext # (fname(0)-3)) THEN›    fname(0)=ext+3›  FI›  IF chr=0 THEN›    str132(0)=fname(0)+3›    str132(1)='D›    str132(2)='1›    str132(3)=':›    FOR cnt=1 TO fname(0) DO›      str132(cnt+3)=fname(cnt) OD›    FOR cnt=0 TO str132(0) DO›      fname(cnt)=str132(cnt) OD›  FI›RETURN››; Write an uncompressed Koala file:›PROC WritePic()›BYTE POINTER IDptr›BYTE I›; Koala header data›BYTE ARRAY ID(4)=[$FF $80 $C9 $C7]›CARD size=[$001A]›BYTE rev=[$01]›BYTE compr=[$00] ;no compression›BYTE mode=[$0E]›BYTE ARRAY active(4)=[$00 $2B $00 $C0]›BYTE ARRAY kolor(5)›CARD length=[7680]›BYTE ARRAY kend(7)=[$00 $00 $9B $9B $9B $9B $A2]››FOR I=0 TO 4›DO› kolor(I)=colpf(I)›OD›IDptr=ID›WriteBlock(1,IDptr,$1B)›WriteBlock(1,SAVMSC,7680)›RETURN››PROC WFile(BYTE n) ; Save the requested screen›Position(10,9)›Print("File ") PrintB(n+1) Print(": ")›IF n=0 THEN› Print(file1)›ELSE› Print(file2)›FI›Position(17,9) Put(' )›InputS(fname)›Test_Name(fname)›Position(17,9) Put(' )›PrintE(fname)›Close(1)›IF n=0 THEN› SCopy(file1,fname)› lastgr=dsl1› textoff()› Open(1,file1,8,0)› SAVMSC=scrn1›ELSE           › SCopy(file2,fname)› lastgr=dsl2› textoff()› Open(1,file2,8,0)› SAVMSC=scrn2›FI›WritePic()›Close(1)›texton()›RETURN››PROC RFile(BYTE n)›Position(10,9)›Print("File ") PrintB(n+1) Print(": ")›Position(17,9) Put(' )›InputS(fname)›Test_Name(fname)›Position(17,9) Put(' )›PrintE(fname)›Close(1)›IF n=0 THEN› SCopy(file1,fname)› lastgr=dsl1› textoff()› Open(1,file1,4,0)› SAVMSC=scrn1›ELSE           › SCopy(file2,fname)› lastgr=dsl2› textoff()› Open(1,file2,4,0)› SAVMSC=scrn2›FI›ReadPic()›SvCol(n)                       ;save colors ›Close(1)›texton()›RETURN››; Format directory entries›PROC Formname(BYTE ARRAY Dptr,buf)›BYTE POINTER Bptr›BYTE j›j=3 ; init input buffer index›Dptr(0)=2 ; init string count›Dptr(1)='  : Dptr(2)=' ›Bptr=Dptr+3 ; point past :›WHILE buf(j) # $20 › DO›   Bptr^=buf(j) ; move in next byte›   Bptr==+1 ; bump pointer›   Dptr(0)==+1 ; up string count›   j==+1 ; bump index to input buffer›   ;   *** dont exceed 8 chars in primary name›   IF j=11 THEN EXIT FI› OD››; deblank input buffer›WHILE buf(j) = $20› DO›  j==+1›  IF j = 14 THEN RETURN FI; NO EXT!› OD›Bptr^='. : Bptr==+1 : Dptr(0)==+1›; fill in ext›WHILE buf(j) # $20› DO›  Bptr^=buf(j) : j==+1›  Bptr==+1 : Dptr(0)==+1› OD›RETURN››; Get directory from file fname›PROC dir()››BYTE I=[0]›I=0›ptr = Dir_string ; init pointer›Position(10,7)›Print("Drive: ")›Position(16,7) Put(' )›InputS(fname)›Test_Name(fname)›Position(16,7) Put(' )›PrintE(fname)›Close(1)›Position(1,9)›Open(1,fname,6,0)›InputSD(1,buf) ; get first file›; dont format # of sectors free msg  ›WHILE buf(2) = $20 ; a good a stopper as any other›  DO›    Formname(ptr,buf)›    PrintE(ptr) ; print file name formed›    ptr==+ptr(0)+1 ; point to next substring›    InputSD(1,buf)›    I==+1›    UNTIL I=14›  OD›Poke($52,20)›Position(20,9)›WHILE buf(2) = $20›  DO›    Formname(ptr,buf)›    PrintE(ptr) ; print file name formed›    ptr==+ptr(0)+1 ; point to next substring›    InputSD(1,buf)›    I==+1›    UNTIL I=28›  OD›IF I=28 THEN› Position(22,23)› Print("...")›FI›Poke($52,2)›Close(1); close dir›RETURN››BYTE FUNC askscr()›BYTE fnum› Position(10,7)› Print("Screen 1 or 2: ")› DO›  Position(24,7)›  Put(' )›  InputS(foo)›  fnum=ValB(foo)›  UNTIL fnum=1 OR fnum=2› OD›RETURN(fnum)››;Koala tablet routines›;››;Simple filter for points›BYTE FUNC Pad(BYTE POINTER l)›BYTE I›CARD ltemp›ltemp=0›FOR I=0 TO 7›DO› ltemp==+l^›OD›I=ltemp RSH 3›RETURN(I)››;Test limits of player icons›BYTE FUNC ilim(BYTE i)›IF i > 208 THEN i=208 FI›RETURN(i)›BYTE FUNC jlim(BYTE j)›IF j > 224 THEN j=224 FI›RETURN(j)››;Positions id number››PROC ident(BYTE c)  ;moves "1" or "2" around screen›IF PTrig(0)=0 THEN  ;test for button pushed› ti=Pad(624)      ;get val› tj=Pad(625)› ti=ilim(ti)      ;limit val› tj=jlim(tj)› IF ti>45 AND tj>30 THEN ;must be on screen›  i(c)=ti›  j(c)=tj›  PMMove(c,i(c),j(c)) ;move icon to new position› FI›ELSE› PMMove(c,i(c),j(c)) ;move icon to last saved position›FI›RETURN››PROC PriCur(BYTE c)›BYTE oldi, oldj›oldi=pi(c) oldj=pj(c)›IF PTrig(0)=0 AND PTrig(1)#0 THEN› ti=Pad(624)› tj=Pad(625)› ti=ilim(ti)› tj=jlim(tj)› IF ti>45 AND tj>30 THEN›  pi(c)=ti pj(c)=tj›  IF pi(c) > pi(c+2) THEN ;push right›   pi(c+2)=pi(c)›  ELSE›   pi(c+2)==+(pi(c)-oldi)›  FI›  IF pj(c) > pj(c+2) THEN ;push down›   pj(c+2)=pi(c)›  ELSE›   pj(c+2)==+(pj(c)-oldj)›  FI›  PMMove(3,pi(c+2),pj(c+2))›  PMMove(2,pi(c),pj(c))› FI›ELSE› PMMove(2,pi(c),pj(c))› PMMove(3,pi(c+2),pj(c+2))›FI›RETURN››PROC SecCur(BYTE c)›BYTE width, height›IF PTrig(0)=0 AND PTrig(1)#0 THEN› ti=Pad(624)› tj=Pad(625)› ti=ilim(ti)› tj=jlim(tj)› IF ti>45 AND tj>30 THEN›  pi(c+2)=ti pj(c+2)=tj›  IF pi(c+2) < pi(c) THEN ;push left›   pi(c)=pi(c+2)›  FI›  IF pj(c+2) < pj(c) THEN ;push up›   pj(c)=pj(c+2)›  FI›  PMMove(2,pi(c),pj(c))   ;ack push›  PMMove(3,pi(c+2),pj(c+2)) ;real move› FI›FI›IF c=0 THEN› width=pi(2)-pi(0)› pi(3)=pi(1)+width› height=pj(2)-pj(0)› pj(3)=pj(1)+width›ELSE ;c=1› width=pi(3)-pi(1)› pi(2)=pi(0)+width› height=pj(3)-pj(1)› pj(2)=pj(0)+height›FI›RETURN››; Swap area between cursors›PROC swap()›FrTRow=pj(0)-30›FrBRow=pj(2)-30›ToTRow=pj(1)-30›ToBRow=pj(3)-30›FrTCol=pi(0)-44›FrBCol=pi(2)-44›ToTCol=pi(1)-44›ToBCol=pi(3)-44›paste(sswap)›RETURN››; Paste to an active screen from the cut/paste buffer›PROC pasted()›BYTE I›IF scrno=0 THEN› ToScr=scrn1›ELSEIF scrno=1 THEN› ToScr=scrn2›FI›FrScr=scrn3›FOR I=1 TO 4›DO› FrScr(I)=cp(I-1)› ToTRow=pj(scrno)-30› ToBRow=pj(scrno+2)-30› ToTCol=pi(scrno)-44› ToBCol=pi(scrno+2)-44›OD›paste(spaste)›RETURN››; Copy from either screen to the cut/paste buffer›PROC cut()›BYTE I››IF scrno=0 THEN› FrScr=scrn1›ELSEIF scrno=1 THEN› FrScr=scrn2›FI› ToScr=scrn3››FrTRow=pj(scrno)-30›ToTRow=pj(scrno)-30›FrBRow=pj(scrno+2)-30›ToBRow=pj(scrno+2)-30›FrTCol=pi(scrno)-44›ToTCol=pi(scrno)-44›FrBCol=pi(scrno+2)-44›ToBCol=pi(scrno+2)-44›CPcol()                        ;save the colors›FOR I=1 TO 4›DO› cp(I-1)=FrScr(I)              ;save where it came from›OD›paste(scut)                    ;cut screen with erase›;pasted()                       ;restore screen›RETURN››; Reverse a selected byte (obverse)›BYTE FUNC obv(BYTE c)›BYTE temp›temp=0›temp=(c & $3) LSH 6›temp==% (c & $C) LSH 2›temp==% (c & $30) RSH 2›temp==% (c & $C0) RSH 6›RETURN(temp)››; Reverse the selected screen (mirror)›PROC mirror(BYTE n)›BYTE i,J,temp1, temp2›BYTE POINTER cell›CARD scr›IF n=0 THEN› scr=scrn1›ELSEIF n=1 THEN› scr=scrn2›ELSEIF n=3 THEN› scr=scrn3›FI›FOR j=0 TO 191›DO› cell=scr+(40*j)  › FOR i=0 TO 19› DO›  temp1=Peek(cell+i)›  temp2=Peek(cell+39-i)›  temp1=obv(temp1)›  temp2=obv(temp2)›  Poke(cell+i,temp2)›  Poke(cell+39-i,temp1)› OD›OD›RETURN››; Edit either screen!›PROC edit()›BYTE svscrno ;screen color to save›BYTE POINTER zap ;screen memory to erase› textoff()                     ;last active screen› DO›  IF key=$12 THEN              ;C›   cut()›   key=255›  ELSEIF key=$0A THEN          ;P›   pasted()›   key=255›  ELSEIF key=$3E THEN          ;S ›   FrScr=scrn1›   ToScr=scrn2›   swap()›   key=255›  ELSEIF key=$0D THEN          ;I ›   ident(scrno)›  ELSEIF key=$0B THEN          ;U›   PriCur(scrno)               ;p2›  ELSEIF key=$00 THEN          ;L›   SecCur(scrno)               ;p3›  ELSEIF key=$1F THEN          ;1›   scrno=0›   PageFlip(scrno)›   ident(scrno)›   PriCur(scrno)›   PMMove(1,0,0)›   key=255›  ELSEIF key=$1E THEN          ;2 ›   scrno=1›   PageFlip(scrno)›   ident(scrno)›   PriCur(scrno)›   PMMove(0,0,0)›   key=255›  ELSEIF key=$1A THEN          ;3 ›   svscrno=scrno›   scrno=3›   pageflip(scrno)›   key=255 ›  ELSEIF key=$39 THEN          ;H›   key=255›   PMGraphics(0)›   texton()›   Position(0,0)›   fullflush()›   help()›   textoff()›   PMGraphics(1)›  ELSEIF key=$25 THEN          ;M›   PMGraphics(0)›   EXIT›  ELSEIF key=$17 THEN          ;Z›   IF scrno=0 THEN›    zap=scrn1›   ELSEIF scrno=1 THEN›    zap=scrn2›   ELSEIF scrno=3 THEN›    zap=scrn3›   FI›   Zero(zap,7680)              ;clears screen›  ELSEIF key=$38 THEN          ;F›   mirror(scrno)›  FI›› OD› key=255› PMMove(0,0,0)› PMMove(1,0,0)› texton() ›RETURN››; Command frame›;›PROC keycom()                  ;process keyboard commands›Error=keycom                   ;disable errors›DO› texton()                       ;turn on text area› Poke($52,1)                    ;left margin› Position(1,0)› PrintE("Cmd Action          Cmd Action")› PrintE(" R  Read a screen    W  Write a screen")› PrintE(" E  Edit screen      D  Directory")› PrintE(" Q  Quit             B  Restart/clear")› PrintE(" H  Help/cmd frame")› Position(1,7)› PrintE("Cmd: ")                ;ask for command› Position(5,7)› Put(' )› InputS(cmd)› ic=ToUpper(cmd(1))             ;force uppercase›; DUMB command parser› IF ic='? THEN›  stat()›  pause()›  flush()› FI› IF ic='Q THEN                  ;bail out›  End()› FI› IF ic='B THEN                  ;reinitialize screens›  screens()› FI› IF ic='H THEN                  ;help frame›  Position(0,0)›  fullflush()›  help()› FI› IF ic='D THEN                  ;read a directory›   dir()›   pause()›   flush()› FI› IF ic='R OR ic='W THEN         ;read a graphics file›  scrno=askscr()-1›  IF ic='R THEN›   RFile(scrno)›  ELSE›   WFile(scrno)›  FI›  flush()› FI› IF ic='E THEN›  PMGraphics(1)›  edit()› FI›OD›RETURN›››PROC main()                    ;central loop›screens()                      ;go setup all screens›banner()                       ;announcements›keycom()›RETURN                         ;never get here...››