home *** CD-ROM | disk | FTP | other *** search
/ Amiga ISO Collection / AmigaUtilCD2.iso / Misc / PKISS77.LHA / PlayKiss / src / l.e < prev    next >
Encoding:
Text File  |  1994-11-09  |  21.5 KB  |  794 lines
  1.  
  2. /* Edit CEL v 0.77 */
  3.  
  4. /*
  5.     No copyright is claimed for *any* material within.
  6.   This source is *currently* Public Domain, and therefore open to free exploitation. */
  7.  
  8. /* Use at your own risk, and watch for hairy palms. */
  9.  
  10.  
  11. /*  November 9, 1994
  12.                                              Chad Randall 
  13.                                                         - mbissaymssiK Software, broken spork division
  14.                         Internet:  crandall@garnet.msen.com
  15.                             USNail:  229 S.Washington St.
  16.                                              Manchester, Michigan, 48158-9680 USA */
  17.  
  18. /* This sucker's not been tested but on my machine.  So let me know about any probs, 'kay? */
  19.  
  20. OPT LARGE
  21.  
  22. MODULE    'graphics/rastport','graphics/gfx','graphics/text','graphics/scale','graphics/view',
  23.                 'graphics/gfxbase','graphics/clip','graphics/layers','graphics/displayinfo'
  24. MODULE    'layers'
  25. MODULE    'intuition/intuition','intuition/screens','intuition/gadgetclass','intuition/screens',
  26.                 'intuition/pointerclass'
  27. MODULE    'libraries/gadtools','gadtools'
  28. MODULE    'dos/dos'
  29. MODULE    'libraries/asl','asl'
  30. MODULE    'tools/async'
  31. MODULE    'wb','workbench/workbench','workbench/startup'
  32. MODULE    'icon'
  33. MODULE    'exec/memory'
  34.  
  35. MODULE    '*doloaddt'
  36. MODULE    '*i3_subs'
  37.  
  38. ENUM OLD_,NEW_
  39. ENUM    DRAG_TOP,DRAG_PAUSE,DRAG_DIRTY,DRAG_BUFFER,DRAG_SMART
  40.  
  41. OBJECT color
  42.     red:LONG
  43.     grn:LONG
  44.     blu:LONG
  45. ENDOBJECT
  46.  
  47. OBJECT palet
  48.     color[260]:ARRAY OF color
  49. ENDOBJECT
  50.  
  51.  
  52. DEF filename[500]:STRING
  53. DEF paletname[500]:STRING
  54. DEF dtname[500]:STRING
  55. DEF ppmname[500]:STRING
  56.  
  57. DEF vp:PTR TO viewport,cm,depth,scrw,scrh,menu,vis
  58. DEF rp:PTR TO rastport,winw,winh
  59.  
  60. DEF quit=FALSE,newproj=FALSE
  61. DEF mode=0
  62. DEF config_size_x,config_size_y
  63.  
  64. DEF disp:PTR TO rastport
  65. DEF scr:PTR TO screen
  66. DEF win:PTR TO window,outwin:PTR TO window
  67. DEF fixxed=FALSE,rtdrag=4,waittof=TRUE,hand=FALSE,bound=TRUE
  68. DEF string[500]:STRING
  69. DEF iconbmap=0:PTR TO bitmap,iconwidth,iconheight,oldx,oldy
  70. DEF copybmap=0:PTR TO bitmap,copyrast:PTR TO rastport
  71. DEF backbmap=0:PTR TO bitmap,backrast:PTR TO rastport
  72. DEF maskbmap=0:PTR TO bitmap
  73. DEF blankbmap=0:PTR TO bitmap,maximumw=1,maximumh=1
  74. DEF palet=0:PTR TO palet
  75. DEF hand1=0,hand2=0,hand3=0
  76. DEF curobj=0,offx,offy,dragmode=0
  77. DEF filereq=0:PTR TO filerequester
  78. DEF paletreq=0:PTR TO filerequester
  79. DEF dtreq=0:PTR TO filerequester
  80. DEF ppmreq=0:PTR TO filerequester
  81. ENUM OFF=FALSE,ON=TRUE
  82. DEF outputmode=0
  83. DEF pauseflag=FALSE
  84. DEF iinfo:PTR TO imageinfo
  85. DEF goodload,xsize,ysize,nxsize,nysize,xoff,yoff
  86.  
  87. CONST FILE_MARK_CELL=$20,FILE_MARK_PALET=$10
  88.  
  89.  
  90. RAISE "CHIP" IF AllocBitMap()=FALSE
  91. RAISE "MEM" IF AllocMem()=FALSE
  92. RAISE "MEM" IF New()=FALSE
  93. RAISE "^C" IF CtrlC()=TRUE
  94.  
  95. PROC version()
  96.     WriteF('\s',{versionstring})
  97. ENDPROC
  98.  
  99. versionstring:
  100. CHAR    '\0$VER: edit cel 0.77 (9.11.94) \tPUBLIC DOMAIN --- NOT FOR RESALE\0\0'
  101.  
  102. PROC reportmousemoves(win:PTR TO window)
  103.     Forbid()
  104.     win.flags:=win.flags OR WFLG_REPORTMOUSE
  105.     Permit()
  106. ENDPROC
  107. PROC noreportmousemoves(win:PTR TO window);DEF flag
  108.     Forbid()
  109.     flag:=win.flags
  110.     IF (flag AND WFLG_REPORTMOUSE) THEN flag:=flag-WFLG_REPORTMOUSE
  111.     win.flags:=flag
  112.     Permit()
  113. ENDPROC
  114.  
  115. PROC busy()
  116.     SetWindowPointerA(win,[$80000098,TRUE,WA_POINTERDELAY,TRUE,NIL,NIL])
  117.     ModifyIDCMP(win,IDCMP_MENUPICK)
  118.     StrCopy(string,'Edit CEL 0.77  *BUSY*',ALL)
  119.     SetWindowTitles(win,-1,string)
  120. ENDPROC
  121.  
  122. PROC ready()
  123.     ClearPointer(win)
  124.     ModifyIDCMP(win,IDCMP_MENUPICK OR IDCMP_MENUVERIFY)
  125.     StringF(string,'Edit CEL 0.77  (\dx\d)',xsize,ysize)
  126.     SetWindowTitles(win,-1,string)
  127. ENDPROC
  128.  
  129.  
  130. PROC main() HANDLE
  131.     DEF i,ii,t,zz,tt,zzz
  132.     DEF mes:PTR TO intuimessage
  133.     DEF hit,hitflag=0,palload=0,iadd:PTR TO menuitem,drawx,drawy
  134.     DEF dir[500]:STRING,file[250]:STRING,buffer
  135.     DEF args:PTR TO wbarg,wstr[250]:STRING,toolobject=NIL:PTR TO diskobject
  136.     DEF region1,rectangle:PTR TO rectangle
  137.     DEF olddir,dirrr,wb:PTR TO wbstartup
  138.     DEF argarray[32]:LIST,rdarg=0,gotme=0,check,code=0,du=0
  139.     DEF zx,zy,zw,zh,zox,zoy
  140.     DEF oldfh=0,newfh=0,filebuf=0,bufptr,filelen=1
  141.     DEF menuverify=FALSE
  142.     DEF fh1,fbuf=0,byte_h,byte_l,r,g,b,bpp,numc
  143.  
  144.     IF (KickVersion(39)=0)
  145.         Raise("Kick")
  146.     ENDIF
  147.  
  148.     buffer:=New(260*16)
  149.     NEW palet,iinfo
  150.     IF (iconbase:=OpenLibrary('icon.library', 37))=NIL THEN Raise("LIB")
  151.     IF (aslbase:=OpenLibrary('asl.library', 37))=NIL THEN Raise("LIB")
  152.     IF (gadtoolsbase:=OpenLibrary('gadtools.library',37))=NIL THEN Raise("LIB")
  153.     IF (layersbase:=OpenLibrary('layers.library',37))=NIL THEN Raise("LIB")
  154.  
  155.     IF wbmessage<>NIL
  156.         outputmode:=TRUE
  157.         wb:=wbmessage;args:=wb.arglist
  158.         olddir:=CurrentDir(args.lock)
  159.         IF args.name>0
  160.             GetCurrentDirName(wstr,250)
  161.             StrCopy(filename,wstr,ALL);AddPart(filename,'',490)
  162.             StrAdd(wstr,args.name,ALL)
  163.             toolobject:=GetDiskObjectNew(wstr)
  164.             CurrentDir(olddir)
  165.         ENDIF
  166.         IF wb.numargs>1
  167.             olddir:=args[].lock++ ->skip our lock! olddir is meaningless at this point
  168.             IF args.lock
  169.                 olddir:=CurrentDir(args.lock)
  170.                 GetCurrentDirName(filename,490)
  171.                 NameFromLock(args.lock,wstr,240)
  172.                 CurrentDir(olddir)
  173.                 AddPart(filename,args.name,490)
  174.                 StrCopy(dtname,filename,ALL)
  175.                 StrCopy(ppmname,filename,ALL)
  176.                 StrCopy(paletname,filename,ALL)
  177.             ENDIF
  178.         ENDIF
  179.         IF (toolobject<>0)
  180.             IF (du:=FindToolType(toolobject.tooltypes,'DEPTH'))
  181.                 StrToLong(du,{rtdrag})
  182.                 IF rtdrag<4 THEN rtdrag:=4
  183.                 IF rtdrag>4 THEN rtdrag:=8
  184.             ENDIF
  185.             IF (du:=FindToolType(toolobject.tooltypes,'PICTURE_DIRECTORY'))
  186.                 StrCopy(dtname,du,ALL)
  187.                 AddPart(dtname,'',490)
  188.                 StrCopy(ppmname,du,ALL)
  189.                 AddPart(ppmname,'',490)
  190.             ENDIF
  191.             IF (du:=FindToolType(toolobject.tooltypes,'PICDIR'))
  192.                 StrCopy(dtname,du,ALL)
  193.                 AddPart(dtname,'',490)
  194.             ENDIF
  195.             IF (du:=FindToolType(toolobject.tooltypes,'KISS_DIRECTORY'))
  196.                 StrCopy(filename,du,ALL)
  197.                 AddPart(filename,'',490)
  198.                 StrCopy(paletname,du,ALL)
  199.                 AddPart(paletname,'',490)
  200.             ENDIF
  201.             IF (du:=FindToolType(toolobject.tooltypes,'CELDIR'))
  202.                 StrCopy(filename,du,ALL)
  203.                 AddPart(filename,'',490)
  204.             ENDIF
  205.             IF (du:=FindToolType(toolobject.tooltypes,'KCFDIR'))
  206.                 StrCopy(paletname,du,ALL)
  207.                 AddPart(paletname,'',490)
  208.             ENDIF
  209.             IF (du:=FindToolType(toolobject.tooltypes,'INITIAL_KCF'))
  210.                 StrCopy(paletname,du,ALL)
  211.                 palload:=555
  212.             ENDIF
  213.             FreeDiskObject(toolobject)
  214.         ENDIF
  215.     ELSE
  216.         FOR i:=0 TO 30
  217.             argarray[i]:=NIL
  218.         ENDFOR
  219.         rdarg:=ReadArgs('WORKDIR=K,PICDIR=P,KCF/K,DEPTH=D/N',argarray,0)
  220.         IF rdarg
  221.             IF argarray[0]
  222.                 StrCopy(filename,argarray[0],ALL)
  223.                 AddPart(filename,'',490)
  224.                 StrCopy(paletname,argarray[0],ALL)
  225.                 AddPart(paletname,'',490)
  226.                 StrCopy(dtname,argarray[0],ALL)
  227.                 AddPart(dtname,'',490)
  228.                 StrCopy(ppmname,argarray[0],ALL)
  229.                 AddPart(ppmname,'',490)
  230.             ENDIF
  231.             IF argarray[1]
  232.                 StrCopy(dtname,argarray[1],ALL)
  233.                 AddPart(dtname,'',490)
  234.                 StrCopy(ppmname,argarray[1],ALL)
  235.                 AddPart(ppmname,'',490)
  236.             ENDIF
  237.             IF argarray[2]
  238.                 StrCopy(paletname,argarray[2],ALL)
  239.                 palload:=555
  240.             ENDIF
  241.             IF argarray[3]
  242.                 rtdrag:=argarray[3]
  243.                 rtdrag:=^rtdrag
  244.                 IF rtdrag<4 THEN rtdrag:=4
  245.                 IF rtdrag>4 THEN rtdrag:=8
  246.             ENDIF
  247.             FreeArgs(rdarg)
  248.         ENDIF
  249.     ENDIF
  250.  
  251.     filereq:=AllocAslRequest(ASL_FILEREQUEST,[ASLFR_INITIALPATTERN,'#?.CEL',NIL,NIL])
  252.     paletreq:=AllocAslRequest(ASL_FILEREQUEST,[ASLFR_INITIALPATTERN,'#?.KCF',NIL,NIL])
  253.     dtreq:=AllocAslRequest(ASL_FILEREQUEST,[ASLFR_INITIALPATTERN,'#?',NIL,NIL])
  254.     ppmreq:=AllocAslRequest(ASL_FILEREQUEST,[ASLFR_INITIALPATTERN,'#?.ppm',NIL,NIL])
  255.  
  256.     scr:=LockPubScreen('Workbench')
  257.     config_size_x:=scr.width
  258.     config_size_y:=(scr.height+scr.barheight+1)
  259.     UnlockPubScreen(0,scr);scr:=0
  260.     openscreen(rtdrag)
  261.     GetRGB32(cm,0,256,buffer)
  262.     FOR i:=0 TO 255
  263.         palet.color[i].red:=Long(buffer+(i*12))
  264.         palet.color[i].grn:=Long(buffer+(i*12)+4)
  265.         palet.color[i].blu:=Long(buffer+(i*12)+8)
  266.     ENDFOR
  267.     WHILE quit=FALSE
  268.         updatecolors()
  269.         WHILE ((quit=FALSE) AND (newproj=FALSE))
  270.             Wait(-1)
  271.             CtrlC()
  272.             hitflag:=0
  273.             WHILE (mes:=Gt_GetIMsg(win.userport))
  274.                 IF (mes.class=IDCMP_MENUVERIFY)
  275.                     menucolors(buffer)
  276.                 ENDIF
  277.                 IF (mes.class=IDCMP_MENUPICK)
  278.                     code:=mes.code
  279.                     WHILE (code<>MENUNULL)
  280.                         iadd:=ItemAddress(menu,code)
  281.                         IF iadd
  282.                             hit:=Long(iadd+34)
  283.                             check:=(Int(iadd+12) AND CHECKED)
  284.                             IF ((hit>0) AND (hit<10)) THEN hitflag:=hit
  285.                             IF hit=66 THEN quit:=TRUE
  286.                             code:=iadd.nextselect
  287.                         ELSE
  288.                             code:=MENUNULL
  289.                         ENDIF
  290.                     ENDWHILE
  291.                     updatecolors()
  292.                 ENDIF
  293.           Gt_ReplyIMsg(mes)
  294.             ENDWHILE
  295.             IF (palload) THEN hitflag:=1
  296.             SELECT hitflag
  297.             CASE 1
  298.                 busy()
  299.                 IF palload=0
  300.                     WbenchToFront()
  301.                     splitname(paletname,dir,file)
  302.                     ii:=AslRequest(paletreq,[ASL_HAIL,'Select .KCF file',
  303.                             ASL_OKTEXT,'_Open',ASL_FILE,file,ASL_DIR,dir,
  304.                             ASLFR_DOPATTERNS,TRUE,ASLFR_DOSAVEMODE,FALSE,FILF_NEWIDCMP,TRUE,NIL,NIL])
  305.                     WbenchToBack()
  306.                 ELSE
  307.                     ii:=TRUE
  308.                 ENDIF
  309.                 IF ii
  310.                     IF palload=0
  311.                         StrCopy(paletname,paletreq.drawer,ALL)
  312.                         AddPart(paletname,paletreq.file,490)
  313.                     ENDIF
  314.                     fh1:=Open(paletname,MODE_OLDFILE)
  315.                     IF fh1
  316.                         fbuf:=New(500)
  317.                         Read(fh1,fbuf,32)
  318.                         IF Long(fbuf)="KiSS"
  319.                             IF Char(fbuf+4)=FILE_MARK_PALET
  320.                                 bpp:=Char(fbuf+5)
  321.                                 numc:=ibmconv(Int(fbuf+8))
  322.                                 FOR i:=0 TO numc-1
  323.                                     IF bpp=12
  324.                                         Read(fh1,fbuf,2)
  325.                                         byte_l:=Char(fbuf)
  326.                                         byte_h:=Char(fbuf+1)
  327.                                         r:=(Shr(byte_l,4) AND $F)*$1111
  328.                                         g:=(byte_h AND $F)*$1111
  329.                                         b:=(byte_l AND $F)*$1111
  330.                                     ELSE
  331.                                         Read(fh1,fbuf,1);r:=Shl(Char(fbuf),8) OR Char(fbuf)
  332.                                         Read(fh1,fbuf,1);g:=Shl(Char(fbuf),8) OR Char(fbuf)
  333.                                         Read(fh1,fbuf,1);b:=Shl(Char(fbuf),8) OR Char(fbuf)
  334.                                     ENDIF
  335.                                     r:=(Shl(Shl(r,8),8) OR r)
  336.                                     g:=(Shl(Shl(g,8),8) OR g)
  337.                                     b:=(Shl(Shl(b,8),8) OR b)
  338.                                     palet.color[i].red:=r
  339.                                     palet.color[i].grn:=g
  340.                                     palet.color[i].blu:=b
  341.                                 ENDFOR
  342.                             ENDIF
  343.                         ELSE
  344.                             Seek(fh1,0,OFFSET_BEGINNING)
  345.                             FOR i:=0 TO 15
  346.                                 Read(fh1,fbuf,2)
  347.                                 byte_l:=Char(fbuf)
  348.                                 byte_h:=Char(fbuf+1)
  349.                                 r:=(Shr(byte_l,4) AND $F)*$1111
  350.                                 g:=(byte_h AND $F)*$1111
  351.                                 b:=(byte_l AND $F)*$1111
  352.                                 r:=(Shl(Shl(r,8),8) OR r)
  353.                                 g:=(Shl(Shl(g,8),8) OR g)
  354.                                 b:=(Shl(Shl(b,8),8) OR b)
  355.                                 palet.color[i].red:=r
  356.                                 palet.color[i].grn:=g
  357.                                 palet.color[i].blu:=b
  358.                             ENDFOR
  359.                         ENDIF
  360.                         Dispose(fbuf)
  361.                         Close(fh1)
  362.                         updatecolors()
  363.                     ENDIF
  364.                 ENDIF
  365.             CASE 2
  366.                 busy()
  367.                 WbenchToFront()
  368.                 splitname(filename,dir,file)
  369.                 ii:=AslRequest(filereq,[ASL_HAIL,'Select .CEL file',
  370.                         ASL_OKTEXT,'_Open',ASL_FILE,file,ASL_DIR,dir,
  371.                         ASLFR_DOPATTERNS,TRUE,ASLFR_DOSAVEMODE,FALSE,FILF_NEWIDCMP,TRUE,NIL,NIL])
  372.                 WbenchToBack()
  373.                 IF ii
  374.                     StrCopy(filename,filereq.drawer,ALL)
  375.                     AddPart(filename,filereq.file,490)
  376.                     fh1:=Open(filename,MODE_OLDFILE)
  377.                     IF fh1
  378.                         fbuf:=New(8000)
  379.                         SetRast(rp,0)
  380.                         Read(fh1,fbuf,4)
  381.                         IF Long(fbuf)="KiSS"
  382.                             Read(fh1,fbuf,28)
  383.                             IF Char(fbuf)=FILE_MARK_CELL
  384.                                 nxsize:=ibmconv(Int(fbuf+4))
  385.                                 nysize:=ibmconv(Int(fbuf+6))
  386.                                 xoff:=ibmconv(Int(fbuf+8))
  387.                                 yoff:=ibmconv(Int(fbuf+10))
  388.                                 xsize:=nxsize+xoff
  389.                                 ysize:=nysize+yoff
  390.                                 bpp:=Char(fbuf+1)
  391.                                 IF bpp=4
  392.                                     FOR t:=0 TO nysize-1
  393.                                         Read(fh1,fbuf,(nxsize/2))
  394.                                         FOR i:=0 TO (nxsize-1) STEP 2
  395.                                             byte_h:=Char(fbuf+(i/2))
  396.                                             SetAPen(rp,Shr(byte_h AND $F0,4))
  397.                                             WritePixel(rp,xoff+i,xoff+t)
  398.                                             SetAPen(rp,byte_h AND $F)
  399.                                             WritePixel(rp,xoff+i+1,yoff+t)
  400.                                         ENDFOR
  401.                                     ENDFOR
  402.                                 ELSE
  403.                                     FOR t:=0 TO nysize-1
  404.                                         Read(fh1,fbuf,nxsize)
  405.                                         FOR i:=0 TO nxsize-1
  406.                                             byte_h:=Char(fbuf+i)
  407.                                             SetAPen(rp,byte_h)
  408.                                             WritePixel(rp,xoff+i,xoff+t)
  409.                                         ENDFOR
  410.                                     ENDFOR
  411.                                 ENDIF
  412.                             ELSE
  413.                                 DisplayBeep(0)
  414.                             ENDIF
  415.                         ELSE
  416.                             nxsize:=ibmconv(Int(fbuf))
  417.                             nysize:=ibmconv(Int(fbuf+2))
  418.                             IF ((nxsize<2) OR (nxsize>640) OR (nysize<2) OR (nysize>400))
  419.                                 DisplayBeep(0)
  420.                             ELSE
  421.                                 xsize:=((nxsize)/2)*2
  422.                                 ysize:=nysize
  423.                                 FOR t:=0 TO ysize-1
  424.                                     Read(fh1,fbuf,(xsize/2))
  425.                                     FOR i:=0 TO (xsize-1) STEP 2
  426.                                         byte_h:=Char(fbuf+(i/2))
  427.                                         SetAPen(rp,Shr(byte_h AND $F0,4))
  428.                                         WritePixel(rp,i,t)
  429.                                         SetAPen(rp,byte_h AND $F)
  430.                                         WritePixel(rp,i+1,t)
  431.                                     ENDFOR
  432.                                 ENDFOR
  433.                             ENDIF
  434.                         ENDIF
  435.                         Dispose(fbuf)
  436.                         Close(fh1)
  437.                     ENDIF
  438.                 ENDIF
  439.             CASE 3
  440.                 busy()
  441.                 WbenchToFront()
  442.                 splitname(dtname,dir,file)
  443.                 ii:=AslRequest(dtreq,[ASL_HAIL,'Select Picture file',
  444.                         ASL_OKTEXT,'_Open',ASL_FILE,file,ASL_DIR,dir,
  445.                         ASLFR_DOPATTERNS,TRUE,ASLFR_DOSAVEMODE,FALSE,FILF_NEWIDCMP,TRUE,NIL,NIL])
  446.                 WbenchToBack()
  447.                 IF ii
  448.                     StrCopy(dtname,dtreq.drawer,ALL)
  449.                     AddPart(dtname,dtreq.file,490)
  450.                 ENDIF
  451.                 goodload:=(doloaddt(dtname,rp,cm,0,0,config_size_x,config_size_y,[DLDT_CENTER,FALSE,
  452.                     DLDT_INTEGERSCALE,FALSE,
  453.                     DLDT_DITHER,TRUE,
  454.                     DLDT_REMAP,TRUE,
  455.                     DLDT_ASPECTX,1,
  456.                     DLDT_ASPECTY,1,
  457.                     DLDT_SCALE,TRUE,
  458.                     DLDT_USEASPECT,TRUE,
  459.                     DLDT_ENLARGE,FALSE,
  460.                     DLDT_CLEAR,TRUE,
  461.                     DLDT_INFO,iinfo,
  462.                     DLDT_HIGHPEN,-1,NIL,NIL]))
  463.                 IF goodload=0
  464.                     xsize:=(iinfo.destination_w+1)/2*2
  465.                     ysize:=iinfo.destination_h
  466.                 ENDIF
  467.             CASE 4
  468.                 menucolors(buffer)
  469.                 EasyRequestArgs(win,[20,0,'Load .ppm file...',
  470.                     'Loading a .ppm file is not implemented yet.',
  471.                     'Ok'],0,0)
  472.                 updatecolors()
  473. ->                busy()
  474. ->                WbenchToFront()
  475. ->                splitname(ppmname,dir,file)
  476. ->                ii:=AslRequest(ppmreq,[ASL_HAIL,'Select ppm file',
  477. ->                        ASL_OKTEXT,'_Open',ASL_FILE,file,ASL_DIR,dir,
  478. ->                        ASLFR_DOPATTERNS,TRUE,ASLFR_DOSAVEMODE,FALSE,FILF_NEWIDCMP,TRUE,NIL,NIL])
  479. ->                WbenchToBack()
  480. ->                IF ii
  481. ->                    StrCopy(ppmname,ppmreq.drawer,ALL)
  482. ->                    AddPart(ppmname,ppmreq.file,490)
  483. ->                ENDIF
  484.             CASE 5
  485.                 busy()
  486.                 WbenchToFront()
  487.                 splitname(paletname,dir,file)
  488.                 ii:=AslRequest(paletreq,[ASL_HAIL,'Select .KCF file',
  489.                         ASL_OKTEXT,'_Save',ASL_FILE,file,ASL_DIR,dir,
  490.                         ASLFR_DOPATTERNS,TRUE,ASLFR_DOSAVEMODE,TRUE,FILF_NEWIDCMP,TRUE,NIL,NIL])
  491.                 WbenchToBack()
  492.                 IF ii
  493.                     StrCopy(paletname,paletreq.drawer,ALL)
  494.                     AddPart(paletname,paletreq.file,490)
  495.                     fh1:=Open(paletname,MODE_NEWFILE)
  496.                     IF fh1
  497.                         fbuf:=New(500)
  498.                         FOR i:=0 TO 31
  499.                             PutChar(fbuf,0)
  500.                         ENDFOR
  501.                         PutLong(fbuf,"KiSS")
  502.                         PutChar(fbuf+4,FILE_MARK_PALET)
  503.                         PutChar(fbuf+5,24)
  504.                         PutInt(fbuf+8,ibmconv(IF depth=4 THEN 16 ELSE 256))
  505.                         Write(fh1,fbuf,32)
  506.                         FOR t:=0 TO 9
  507.                             FOR i:=0 TO IF (depth=4) THEN 15 ELSE 255
  508.                                 PutChar(fbuf+(i*3),palet.color[i].red)
  509.                                 PutChar(fbuf+(i*3)+1,palet.color[i].grn)
  510.                                 PutChar(fbuf+(i*3)+2,palet.color[i].blu)
  511.                             ENDFOR
  512.                             Write(fh1,fbuf,IF (depth=4) THEN 16*3 ELSE 256*3)
  513.                         ENDFOR
  514.                         Dispose(fbuf)
  515.                         Close(fh1)
  516.                     ENDIF
  517.                 ENDIF
  518.             CASE 6
  519.                 busy()
  520.                 WbenchToFront()
  521.                 splitname(filename,dir,file)
  522.                 ii:=AslRequest(filereq,[ASL_HAIL,'Select .CEL file',
  523.                         ASL_OKTEXT,'_Save',ASL_FILE,file,ASL_DIR,dir,
  524.                         ASLFR_DOPATTERNS,TRUE,ASLFR_DOSAVEMODE,TRUE,FILF_NEWIDCMP,TRUE,NIL,NIL])
  525.                 WbenchToBack()
  526.                 IF ii
  527.                     StrCopy(filename,filereq.drawer,ALL)
  528.                     AddPart(filename,filereq.file,490)
  529.                     xoff:=xsize
  530.                     SetAPen(rp,1)
  531.                     FOR i:=0 TO ysize
  532.                         FOR t:=0 TO xoff
  533.                             IF ReadPixel(rp,t,i)<>0
  534.                                 xoff:=smaller(xoff,t)
  535.                                 t:=xoff
  536.                             ENDIF
  537.                         ENDFOR
  538.                     ENDFOR
  539.                     yoff:=ysize
  540.                     FOR i:=0 TO xsize
  541.                         FOR t:=0 TO yoff
  542.                             IF ReadPixel(rp,i,t)<>0
  543.                                 yoff:=smaller(yoff,t)
  544.                                 t:=yoff
  545.                             ENDIF
  546.                         ENDFOR
  547.                     ENDFOR
  548. WriteF('\d,\d',xoff,yoff)
  549.                     xsize:=((xsize-xoff+1)/2)*2
  550.                     ysize:=ysize-yoff
  551. WriteF('\d,\d',xsize,ysize)
  552.                     ClipBlit(rp,xoff,yoff,rp,0,0,xsize,ysize,192)
  553.                     SetAPen(rp,0)
  554.                     RectFill(rp,xsize,0,3000,2000)
  555.                     RectFill(rp,0,ysize,3000,2000)
  556.  
  557.  
  558.                     nxsize:=0
  559.                     FOR i:=ysize TO 0 STEP -1
  560.                         FOR t:=xsize TO nxsize STEP -1
  561.                             IF ReadPixel(rp,t,i)<>0
  562.                                 nxsize:=t
  563.                                 t:=nxsize
  564.                             ENDIF
  565.                         ENDFOR
  566.                     ENDFOR
  567.                     nysize:=0
  568.                     FOR i:=xsize TO 0 STEP -1
  569.                         FOR t:=ysize TO nysize STEP -1
  570.                             IF ReadPixel(rp,i,t)<>0
  571.                                 nysize:=t
  572.                                 t:=nysize
  573.                             ENDIF
  574.                         ENDFOR
  575.                     ENDFOR
  576.                     xsize:=((nxsize+1)/2)*2
  577.                     ysize:=nysize
  578.  
  579.                     fh1:=Open(filename,MODE_NEWFILE)
  580.                     IF fh1
  581.                         fbuf:=New(6000)
  582.                         FOR i:=0 TO 31
  583.                             PutChar(fbuf,0)
  584.                         ENDFOR
  585.                         PutLong(fbuf,"KiSS")
  586.                         PutChar(fbuf+4,FILE_MARK_CELL)
  587.                         PutChar(fbuf+5,IF (depth=4) THEN 4 ELSE 8)
  588.                         PutInt(fbuf+8, ibmconv(xsize))
  589.                         PutInt(fbuf+10,ibmconv(ysize))
  590.                         PutInt(fbuf+12,ibmconv(xoff))
  591.                         PutInt(fbuf+14,ibmconv(yoff))
  592.                         Write(fh1,fbuf,32)
  593.                         IF (depth=4)
  594.                             FOR t:=0 TO ysize-1
  595.                                 FOR i:=0 TO (xsize-1) STEP 2
  596.                                     PutChar(fbuf+(i/2),(Shl(ReadPixel(rp,i,t) AND $F,4) OR (ReadPixel(rp,i+1,t) AND $F)))
  597.                                 ENDFOR
  598.                                 Write(fh1,fbuf,(xsize/2))
  599.                             ENDFOR
  600.                         ELSE
  601.                             FOR t:=0 TO ysize-1
  602.                                 FOR i:=0 TO xsize-1
  603.                                     PutChar(fbuf+i,ReadPixel(rp,i,t))
  604.                                 ENDFOR
  605.                                 Write(fh1,fbuf,xsize)
  606.                             ENDFOR
  607.                         ENDIF
  608.                         Close(fh1)
  609.                         Dispose(fbuf)
  610.                     ENDIF
  611.                 ENDIF
  612.             CASE 7
  613.                 busy()
  614.                 WbenchToFront()
  615.                 splitname(dtname,dir,file)
  616.                 ii:=AslRequest(dtreq,[ASL_HAIL,'Select IFF file',
  617.                         ASL_OKTEXT,'_Save',ASL_FILE,file,ASL_DIR,dir,
  618.                         ASLFR_DOPATTERNS,TRUE,ASLFR_DOSAVEMODE,TRUE,FILF_NEWIDCMP,TRUE,NIL,NIL])
  619.                 WbenchToBack()
  620.                 IF ii
  621.                     StrCopy(dtname,dtreq.drawer,ALL)
  622.                     AddPart(dtname,dtreq.file,490)
  623.                 ENDIF
  624.             CASE 8
  625.                 busy()
  626.                 WbenchToFront()
  627.                 splitname(ppmname,dir,file)
  628.                 ii:=AslRequest(ppmreq,[ASL_HAIL,'Select ppm file',
  629.                         ASL_OKTEXT,'_Save',ASL_FILE,file,ASL_DIR,dir,
  630.                         ASLFR_DOPATTERNS,TRUE,ASLFR_DOSAVEMODE,TRUE,FILF_NEWIDCMP,TRUE,NIL,NIL])
  631.                 WbenchToBack()
  632.                 IF ii
  633.                     StrCopy(ppmname,ppmreq.drawer,ALL)
  634.                     AddPart(ppmname,ppmreq.file,490)
  635.                 ENDIF
  636.             CASE 9
  637.                 menucolors(buffer)
  638.                 EasyRequestArgs(win,[20,0,'About Edit CEL v0.77',
  639.                     'Written in a few hours by\nChad Randall\ncrandall@garnet.msen.com',
  640.                     'Ok'],0,0)
  641.                 updatecolors()
  642.             ENDSELECT
  643.             ready();palload:=FALSE
  644.         ENDWHILE
  645.     ENDWHILE    
  646.     closescreen()
  647. EXCEPT DO
  648.     closescreen()
  649.     Dispose(buffer)
  650.     IF ((exception="^C") AND (outputmode=0)) THEN WriteF('***BREAK\n')
  651.     IF ((exception="Kick"))
  652.         WriteF('You need at least OS 3.0 (Kickstart 39) to run.\n')
  653.         DisplayBeep(0)
  654.     ENDIF
  655.     IF filereq THEN FreeAslRequest(filereq)
  656.     IF dtreq THEN FreeAslRequest(dtreq)
  657.     IF paletreq THEN FreeAslRequest(paletreq)
  658.     IF ppmreq THEN FreeAslRequest(ppmreq)
  659.  
  660.     IF gadtoolsbase THEN CloseLibrary(gadtoolsbase)
  661.     IF layersbase THEN CloseLibrary(layersbase)
  662.     IF aslbase THEN CloseLibrary(aslbase)
  663.     IF iconbase THEN CloseLibrary(iconbase)
  664.     END palet
  665. ENDPROC
  666.  
  667. PROC menucolors(buffer)
  668.     DEF i
  669.     FOR i:=0 TO 3
  670.         SetRGB32(vp,i,Long(buffer+(i*12)),Long(buffer+(i*12)+4),Long(buffer+(i*12)+8))
  671.     ENDFOR
  672.     FOR i:=17 TO 19
  673.         SetRGB32(vp,i,Long(buffer+(i*12)),Long(buffer+(i*12)+4),Long(buffer+(i*12)+8))
  674.     ENDFOR
  675.     FOR i:=(Shl(1,rtdrag)-4) TO (Shl(1,rtdrag)-1)
  676.         SetRGB32(vp,i,Long(buffer+(i*12)),Long(buffer+(i*12)+4),Long(buffer+(i*12)+8))
  677.     ENDFOR
  678. ENDPROC
  679.  
  680. PROC updatecolors()
  681.     DEF i,pn=0,t
  682.     FOR i:=0 TO 255
  683.         SetRGB32(vp,i,palet.color[i].red,palet.color[i].grn,palet.color[i].blu)
  684.     ENDFOR
  685. ENDPROC
  686.  
  687. PROC isdigit(s);IF (((s>="0") AND (s<="9")) OR (s=".") OR (s="-")) THEN RETURN TRUE;ENDPROC FALSE
  688. PROC isalpha(s);IF (((s>="a") AND (s<="z")) OR ((s>="A") AND (s<="Z"))) THEN RETURN TRUE;ENDPROC FALSE
  689. PROC ispunc(s);IF ((s=".") OR (s="-") OR (s="_")) THEN RETURN TRUE;ENDPROC FALSE
  690.  
  691. PROC scanforvalue(str)
  692.     DEF l=0,i,s[100]:STRING,ins,iii=0
  693.     WHILE (isdigit(Char(str+l)));l:=l+1;ENDWHILE
  694.     StrCopy(s,str,l)
  695.     ins:=InStr(str,'.')
  696.     IF ((ins>0) AND (ins<=l))
  697.         StrToLong(s,{i})
  698.         StrToLong(s+ins+1,{iii})
  699.     ELSE
  700.         StrToLong(s,{i})
  701.     ENDIF
  702. ENDPROC i,l,iii
  703.  
  704. PROC scanforstring(str)
  705.     DEF l=0
  706.     WHILE (isdigit(Char(str+l)) OR isalpha(Char(str+l)) OR ispunc(Char(str+l)));l:=l+1;ENDWHILE
  707. ENDPROC l
  708.  
  709. PROC ibmconv(a)
  710.     DEF hi,lo,ret
  711.     hi:=a AND $FF00
  712.     lo:=a AND $00FF
  713.     ret:=Shl(lo,8) OR Shr(hi,8)
  714. ENDPROC ret
  715.  
  716. PROC openscreen(d)
  717.     DEF cflag,lflag1=CHECKIT,lflag2=CHECKIT,lflag3=CHECKIT,lflag4=CHECKIT,lflag5=CHECKIT,lflag=CHECKIT
  718.     DEF hflag1=CHECKIT,hflag2=CHECKIT,hflag3=CHECKIT,bflag=CHECKIT
  719.     depth:=d
  720.     scr:=OpenScreenTagList(NIL,[SA_LIKEWORKBENCH,TRUE,
  721.         SA_DEPTH,depth,
  722.         SA_TITLE,'Edit CEL',
  723.         SA_COLORMAPENTRIES,256,
  724.         SA_FULLPALETTE,TRUE,
  725.         SA_WIDTH,config_size_x,
  726.         SA_HEIGHT,config_size_y,
  727.         SA_INTERLEAVED,TRUE,
  728.         SA_AUTOSCROLL,TRUE,
  729.         SA_PENS,[-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1]:INT,
  730.         NIL,NIL])
  731.     IF scr=0 THEN Raise("SCR")
  732.     IF (vis:=GetVisualInfoA(scr,NIL))=0 THEN RETURN "VIS"
  733.     win:=OpenWindowTagList(0,[WA_WIDTH,scr.width,WA_HEIGHT,scr.height-scr.barheight-1,
  734.         WA_TOP,scr.barheight+1,WA_LEFT,0,
  735.         WA_FLAGS,WFLG_ACTIVATE OR WFLG_SMART_REFRESH,
  736.         WA_BORDERLESS,TRUE,
  737.         WA_BACKDROP,TRUE,
  738.         WA_CUSTOMSCREEN,scr,
  739.         WA_NEWLOOKMENUS,TRUE,
  740.         WA_IDCMP,IDCMP_MENUPICK OR IDCMP_MENUVERIFY,
  741.         NIL,NIL])
  742.     IF win=0 THEN Raise("WIN")
  743.     vp:=scr.viewport
  744.     cm:=vp.colormap
  745.     rp:=win.rport
  746.  
  747.   IF (menu:=CreateMenusA([NM_TITLE,0,'Project',0,0,0,0,
  748.                                                     NM_ITEM,0,'Open KCF...','K',0,0,1,
  749.                                                     NM_ITEM,0,'Open CEL...','C',0,0,2,
  750.                                                     NM_ITEM,0,'Open Datatype...','O',0,0,3,
  751.                                                     NM_ITEM,0,'Open PPM (P6)','P',0,0,4,
  752.                                                     NM_ITEM,0,NM_BARLABEL,0,0,0,0,
  753.                                                     NM_ITEM,0,'Save KCF','F',0,0,5,
  754.                                                     NM_ITEM,0,'Save CEL','E',0,0,6,
  755.                                                     NM_ITEM,0,'Save IFF','I',0,0,7,
  756.                                                     NM_ITEM,0,'Save PPM (P6)','B',0,0,8,
  757.                                                     NM_ITEM,0,NM_BARLABEL,0,0,0,0,
  758.                                                     NM_ITEM,0,'About','?',0,0,9,
  759.                                                     NM_ITEM,0,'Quit','Q',0,0,66,
  760.  
  761.                                                     NM_END,0,'End','x',0,0,0]:newmenu,NIL))=NIL THEN Raise("MENU")
  762.     LayoutMenusA(menu,vis,[GTMN_NEWLOOKMENUS,TRUE,NIL,NIL])
  763.     SetMenuStrip(win,menu)
  764.     offmenu(4)
  765.     offmenu(7)
  766.     offmenu(8)
  767. ENDPROC
  768.  
  769. PROC offmenu(id)
  770.     DEF a,b,c
  771.     a,b,c:=findmenuid(menu,id)
  772.     IF win THEN OffMenu(win,packmenunumber(a,b,c))
  773. ENDPROC
  774.  
  775. PROC closescreen()
  776.     IF win
  777.         CloseWindow(win)
  778.         win:=0
  779.     ENDIF
  780.     IF menu
  781.         FreeMenus(menu)
  782.         menu:=0
  783.     ENDIF
  784.     IF vis
  785.         FreeVisualInfo(vis)
  786.         vis:=0
  787.     ENDIF
  788.     IF scr
  789.         CloseScreen(scr)
  790.         scr:=0
  791.     ENDIF
  792.  
  793. ENDPROC
  794.