DEFINE clear="0", intact="1",›       is="=", free="0", taken="1",›       adisk="0", pdisk="1"›;Print Shop Screen Magic›;and Graphic Library ›;File conversion utility›;by Mike Collins›;ver. 3›;10/13/85›;ÃÏÍÐÉÌÅ ÄÉÒÅÃÔÌÙ ÆÒÏÍ ÄÉÓË®    ›;ÃÏÍÐÉÌÅ ÉΠÃÁÓÅ ÓÅÎÓÉÔÉÖÅ ÍÏÄÅ®›BYTE ramtop=106, hitop, lotop,›picflag=[0], over, margin=82, vtab=84,›htab=85›BYTE ARRAY fname, filename,›         vtocsec(128), vtoc,›         mask=[128 64 32 16 8 4 2 1],›         dirbuf(129), psid=['P 'R 'I]›CARD smem=88, screen, dlhi, xpos, ypos›TYPE directory=[BYTE n0,n1,n2,n3,n4,›n5,n6,n7,n8,n9,na,nb,nc,nd,ne,nf›CARD startsec, PA, bytes]›directory POINTER file›;************************************›;Burst (Block) I/O routines to do›;quick disk I/O, utilizing a call to›;CIO›;************************************››PROC CIO=$E456(BYTE areg,xreg)››;************************************››CARD FUNC Burst(BYTE chan,mode,›                CARD addr,buflen)››  TYPE IOCB=[BYTE id,num,cmd,stat›             CARD badr,padr,blen›             BYTE a1,a2,a3,a4,a5,a6]››  IOCB POINTER iptr››  chan==&$07›  iptr=$340+(chan LSH 4)›  iptr.cmd=mode›  iptr.blen=buflen›  iptr.badr=addr›  CIO(0,chan LSH 4)›RETURN(iptr.stat)›;************************************›CARD FUNC BGet(BYTE chan›               CARD addr,len)›  CARD temp›  temp=Burst(chan,7,addr,len)›RETURN (temp)›;************************************›BYTE FUNC BPut(BYTE chan›               CARD addr,len)›BYTE stat›    stat=Burst(chan,11,addr,len)›RETURN(stat)›;************************************›PROC DISKINV=$E453()›;************************************›BYTE FUNC resdisk(BYTE drv, cmd›                  CARD buf, sec)››TYPE DCB=[BYTE sbi, dnum, com, stat›          CARD addr, to, cnt, secnum]›DCB POINTER disk›disk=$300›disk.dnum=drv›disk.com=cmd›disk.addr=buf›disk.secnum=sec›DISKINV()          ›RETURN(disk.stat)               ›;************************************›BYTE FUNC GetSec(BYTE drv›                 CARD buf, sec)›BYTE stat›stat=resdisk(drv, 'R, buf, sec)›RETURN(stat)›;************************************›BYTE FUNC PutSec(BYTE drv›                 CARD buf, sec)›BYTE stat›stat=resdisk(drv, 'W, buf, sec)›RETURN(stat)›;************************************›PROC shift(CARD buffer)›PokeC($CB,buffer)›[24  160 0  8   40  177 203 106 › 145 203 8  200 192 12  208 244 › 40]›RETURN›;************************************›PROC overlay(CARD to, from, length)›BYTE POINTER pointto, pointfrom›CARD count›FOR count=0 TO length-1›DO›pointto=count+to pointfrom=count+from›pointto^=pointto^ OR pointfrom^›OD›RETURN›;************************************›PROC vdelay()›BYTE jiffy, clock=20›jiffy=clock      ;This loop ensures›DO               ;that 1 vbl interupt›UNTIL jiffy#clock;will occur. All ›OD               ;hardware registers›RETURN           ;will be updated.›;************************************›BYTE FUNC uppercase(BYTE chr)›IF chr>='a AND chr<='z THEN›   RETURN(chr-$20)›FI›RETURN(chr)›;************************************›PROC nobreak() ;disable break key›Poke(16,64) Poke(53774,64)›RETURN›;************************************›PROC ercheck(BYTE ernum)›IF ernum#1  ;error check routine›THEN        ;if ernum<>1 then report›ramtop=lotop ;error to user›Graphics(0) nobreak()›vdelay()›Position(8,11) Print("ERROR #")›PrintBE(ernum)›Position(8,13) Print("Press any key")›ernum=1›GetD(7)›FI›RETURN›;************************************›PROC promptps()›ramtop=lotop›Graphics(0) nobreak()›Put(253) ;bell›Position(4,8) Print("Please remove disk from drive 1")›Position(4,10) Print("and insert PRINT SHOP data disk.")›Position(12,12) PrintE("Ðòåóó áîù ëåù®")›GetD(7)›RETURN›;************************************›PROC promptpic()›ramtop=lotop›Graphics(0) nobreak()›Put(253) ;bell›Position(4,8) Print("Please remove disk from drive 1")›Position(9,10) Print("and insert .PIC disk.")›Position(12,12) PrintE("Ðòåóó áîù ëåù®")›GetD(7)›RETURN›;************************************›PROC init()›vtoc=vtocsec+32›Close(7)›Open(7,"K:",4,0)›hitop=ramtop›Graphics(24) nobreak()›screen=smem›lotop=Peek(561)-1 dlhi=PeekC(560)›Error=ercheck›filename="D1:            "›RETURN›;************************************›PROC showscreen(BYTE option)›BYTE mode, jiffy, clock=20›;clear screen if option=0›ramtop=hitop ;set ramtop for gr.8›IF option=clear THEN› Graphics(24)› nobreak()› picflag=0 ;erase picture›ELSE›PokeC(560,dlhi)›FI›vdelay()›RETURN›;************************************›PROC makename(BYTE ARRAY name)›BYTE x, i, temp›name(0)=14›name(1)='D name(2)=':›name(15)=155›name(14)=name(13)›name(13)=name(12)›name(12)=name(11)›name(11)='.›FOR x=1 TO 10›  DO›   WHILE name(x)=' ›   DO›    FOR i=x TO 15 ›    DO›    name(i)=name(i+1)›    OD›   OD›  OD›FOR x=1 TO 14›DO› IF name(x)=155› THEN name(0)=x-1› FI›OD› IF name(name(0))='.› THEN name(0)==-1› FI›  IF name(10)='. AND name(11)=' ›  THEN name(0)=9›  FI›RETURN›;************************************›BYTE FUNC data_disk()›BYTE x›x=GetSec(1,dirbuf,361)›IF x#1›THEN RETURN(x)›FI› FOR x=0 TO 2› DO›  IF dirbuf(x)#psid(x)›  THEN RETURN(adisk)›  FI› OD›RETURN(pdisk)›;************************************›BYTE FUNC menu()›BYTE selection›ramtop=lotop ;put menu under screen›Graphics(0) nobreak()›margin=11›Position(8,0)›Print("Ðòéîô Óèïð Æéìå Ãïîöåòôåò")›Position(13,1)›Print("    öåò® ³®°   ")›Position(13,2)›Print("âù Í®Ç® Ãïììéîó")›Position(13,3)›PrintE("    ±°¯±³¯¸µ   ")›vtab=9›PrintE("1. Load PS File")›PrintE("2. Load Atari File")›PrintE("3. Save PS File")›PrintE("4. Save Atari File")›DO›vtab=14 htab=margin›Print("Select(1-4):")›selection=GetD(7) selection==&127›Put(selection)›UNTIL selection>'0 AND selection<'5›OD›margin=2›RETURN(selection)›;************************************›CARD FUNC psdir()›BYTE x, stat, dstat   ›CARD sector›dstat=data_disk()›IF dstat=pdisk›THEN›ramtop=lotop›Graphics(0) nobreak()›PrintE("ÓÐÁÃÅ for next file, ÒÅÔÕÒÎ to load")› PutE()› htab=6› PrintE("Filename        File Type")› PutE()› FOR sector=362 TO 393› DO                     ;read› stat=GetSec(1,dirbuf+1,sector);directory›    IF stat#1 THEN›    ercheck(stat)›    EXIT›    FI›   fname=dirbuf›   FOR x=1 TO 4›   DO›   IF fname(1)=0 THEN RETURN(0) FI›   fname(0)=15 file=fname+1›   htab=6›   Print(fname) ;print filenames›   Print(" ")›    IF file.bytes<641›    THEN PrintE("Graphic")›    ELSE PrintE("Screen Magic")›    FI›     IF GetD(7)=155 THEN›     filename(1)='D›     filename(2)=':›     filename(0)=15›     MoveBlock(filename+3,fname+1,8)›     RETURN(file.startsec)›     FI›   fname==+32›   OD› OD›ELSEIF dstat=adisk›THEN›promptps()›ELSE ercheck(dstat)›FI›RETURN(0)›;************************************›CARD FUNC dir()›BYTE dstat›BYTE ARRAY name(20)›dstat=data_disk()›IF dstat=adisk›THEN›Graphics(0) nobreak()›PrintE("ÓÐÁÃÅ for next file, ÒÅÔÕÒÎ to load")› PutE()›Close(1)›Open(1,"D:*.*",6,0) ;read directory›DO›InputSD(1,name)› IF name(14)='O THEN EXIT FI›htab=10›PrintE(name)› IF GetD(7)=155› THEN› makename(name)› EXIT FI›OD›Close(1)›ELSEIF dstat=pdisk›THEN›promptpic()›ELSE ercheck(dstat)›FI›RETURN(name)›;************************************›BYTE FUNC getcoord()›BYTE option›ramtop=lotop›Graphics(0) nobreak()›xpos=0 ypos=0›Position(8,5) Print("This is a graphic file.")›DO›Position(6,7) Print("Enter X coordinate(0-232):      ~~~~~~")›xpos=InputC()›UNTIL xpos<233›OD›DO›Position(6,9) Print("Enter Y coordinate(0-140):      ~~~~~~")›ypos=InputC()›UNTIL ypos<141›OD› IF picflag=1› THEN› DO› Position(6,11) Print("Ãlear or Åxisting Screen?:    ~~~~")› option=GetD(7) option==&127› option=uppercase(option)› UNTIL option='C OR option='E› OD Put(option)›  IF option='E›  THEN›  DO›  Position(6,13) Print("Overlay(Y/N)?:")›  over=GetD(7) over==&127›  over=uppercase(over)›  UNTIL over='Y OR over='N›  OD Put(over)›  FI›  ELSE option='C over='N›  FI›   IF option='C›   THEN option=clear›   ELSE option=intact›   FI›RETURN(option)›;************************************›BYTE FUNC loadps(CARD sector) ;return error #›BYTE stat›CARD offset, seccnt›offset=0›showscreen(clear)›FOR seccnt=1 TO 61›DO›stat=GetSec(1,screen+offset,sector)›  IF stat#1 THEN EXIT FI›offset==+126›sector=PeekC(screen+offset);sector link›IF sector=0 OR sector>720›THEN EXIT FI›OD›ercheck(stat)›picflag=1›GetD(7)›RETURN(stat)›;************************************›BYTE FUNC gfxload(CARD sector, option) ;return error #›BYTE stat, wait, bak=710, point=709,›     i, bits›BYTE ARRAY gfxbuf(640), shiftbuf(12)›CARD offset, seccnt›offset=0›showscreen(option) bak=8 point=0›vdelay()›FOR seccnt=1 TO 5›DO› stat=GetSec(1,gfxbuf+offset,sector)›  IF stat#1 THEN EXIT FI› offset==+126› sector=PeekC(gfxbuf+offset);sector link›   IF sector=0 OR sector>720›   THEN EXIT FI›OD›ercheck(stat)›picflag=1›bits=xpos&7 xpos== RSH 3 › FOR offset=0 TO 51› DO›  IF bits#0 THEN shiftbuf(11)=0›   MoveBlock(shiftbuf,gfxbuf+offset*11,11)›   FOR i=1 TO bits›   DO  ›   shift(shiftbuf)›   OD ›    IF over='Y THEN›    overlay(screen+offset*40+xpos+40*ypos,shiftbuf,12)›    ELSE›    MoveBlock(screen+offset*40+xpos+40*ypos,shiftbuf,12)›    FI›  ELSE›    IF over='Y THEN›    overlay(screen+offset*40+xpos+40*ypos,gfxbuf+offset*11,11)›    ELSE›    MoveBlock(screen+offset*40+xpos+40*ypos,gfxbuf+offset*11,11)›    FI›  FI› OD›GetD(7) ;wait for keypress›RETURN(stat)›;************************************›PROC loadpic(BYTE ARRAY name)›showscreen(clear)›Close(3)›Open(3,name,4,0)›BGet(3,screen,7680)›Close(3)›picflag=1›GetD(7)›RETURN›;************************************›CARD FUNC get_directory_sector()›BYTE x›CARD index› FOR index=362 TO 393   ;start› DO                     ;reading› GetSec(1,dirbuf,index) ;directory›  file=dirbuf›   FOR x=1 TO 4   ;search name field›   DO             ;of each sector›   IF file.n0=0   ;for a zero›   THEN RETURN(index) FI›  file==+32 ›   OD›  OD›RETURN(0) ;directory full›;************************************›BYTE FUNC sec_stat(CARD sector)›BYTE status ;return sector status›BYTE POINTER mem›mem=vtoc+(sector RSH 3)›status=mask(sector&7) AND mem^› IF status#free THEN status=taken› FI›RETURN(status)›;************************************›CARD FUNC free_sectors()›CARD sectors, x›sectors=0›FOR x=1 TO 720›DO› IF sec_stat(x)=free› THEN sectors==+1› FI›OD›RETURN(sectors)›;************************************›PROC take_sector(CARD sector)›BYTE POINTER mem›mem=vtoc+(sector RSH 3)›mem^=mask(sector&7) OR mem^›RETURN›;************************************›CARD FUNC next_free_sector()›CARD num›FOR num=1 TO 721›DO› IF sec_stat(num) is free› THEN EXIT› FI›OD › IF num=721› THEN num=0› FI›RETURN(num)›;************************************›PROC saveps()   ;save in print shop›BYTE x, status  ;format›CARD mem, firstsec, sector,›     sector_link, dirsec›BYTE ARRAY secbuf(128), psname(20)›ramtop=lotop›Graphics(0) nobreak()›IF picflag THEN › IF data_disk()=pdisk› THEN› x=filename(0)› SCopyS(psname,filename,3,x)› psname(0)=x-2› Position(15,8) Print("Print Shop Save")› Position(8,10) Print("Insert Print Shop Data Disk")› Position(8,12) Print("Enter filename or ÒÅÔÕÒÎ.")› Position(8,14) Print(psname)› Position(8,14) Print("") InputS(psname)››;this is the start of the save ›;routine›;************************************›;check vtoc and make sure there are›;at least 61 available sectors››  GetSec(1,vtocsec,361) ;read vtoc›  IF free_sectors()<61›  THEN ercheck(162) ;disk full›  RETURN›  FI ›;************************************›;find first free entry in ps directory››  dirsec=get_directory_sector()›  IF dirsec=0›  THEN ercheck(169)  ; directory full›  FI››;************************************› showscreen(intact)›;this is the main loop to write›;the data sectors and VTOC›  mem=screen›  firstsec=next_free_sector() ;first›   FOR x=1 TO 61            ;sector›   DO›   sector=next_free_sector() ;main›   MoveBlock(secbuf,mem,126) ;loop›   take_sector(sector)›   sector_link=next_free_sector() ›   PokeC(secbuf+126,sector_link)›status=PutSec(1,secbuf,sector)      ›     IF status#1›     THEN ercheck(status)›     RETURN›     FI›   mem==+126›   OD› vtocsec(16)=$E0›status=PutSec(1,vtocsec,361) ;write VTOC›     IF status#1›     THEN ercheck(status)›     RETURN›     FI›;************************************›;enter filename into directory› SetBlock(file,16,32) ;fill with spaces› file.PA=$4150› x=psname(0)› MoveBlock(file,psname+1,x)› file.startsec=firstsec› file.bytes=7680›status=PutSec(1,dirbuf,dirsec) ›     IF status#1›     THEN ercheck(status)›     RETURN›     FI›;************************************› ELSE     › promptps()› FI›ELSE›Put(253)›Position(8,10) Print("No Picture in Memory!")›Position(11,12) Print("Press any key")›GetD(7)›FI›RETURN›;************************************›PROC savepic()›BYTE stat›ramtop=lotop›Graphics(0) nobreak()›IF picflag›THEN › IF data_disk()=adisk› THEN› Position(15,8) Print("Save Screen")› Position(8,10) Print("Insert disk with Atari DOS")› Position(8,12) Print("Enter filename or ÒÅÔÕÒÎ.")› Position(8,14) Print(filename)› Position(8,14) Print("") InputS(filename)› showscreen(intact)› Close(2) ;just in case› Open(2,filename,8,0)› stat=BPut(2,screen,7680)›  IF stat#136 THEN ercheck(stat) FI› Close(2)› ELSE promptpic()› FI›   ELSE›   Put(253)›   Position(8,10) Print("No Picture in Memory!")›   Position(11,12) Print("Press any key")›   GetD(7)›FI›RETURN›;************************************›PROC main()›BYTE choice, stat›CARD start, option›init()›DO› choice=menu()›  IF choice='1›  THEN start=psdir() ;get first sector›    IF start#0›    THEN›     IF file.bytes<641›     THEN option=getcoord()›          gfxload(start,option);load graphic ›     ELSE loadps(start);load picture›     FI›    FI›  ELSEIF choice='2  ›  THEN filename=dir() ;get file name›    IF filename(14)#'O›    AND filename(1)='D›    THEN loadpic(filename)›    FI›  ELSEIF choice='3›     THEN saveps()›  ELSEIF choice='4›   THEN savepic()›  FI ›OD›RETURN››