home *** CD-ROM | disk | FTP | other *** search
- Deck "PaletteDeck"
- Routine "Quit"
- Do "Get_TOOLTYPES"
- Let X=WindowX,Y=WindowY,W=WindowWidth,H=WindowHeight
- If X<>WinX
- Let CP=True
- EndIf
- If Y<>WinY
- Let CP=True
- EndIf
- If W<>WinW
- Let CP=True
- EndIf
- If H<>WinH
- Let CP=True
- EndIf
- If CP=True
- Do "SaveIcon"
- EndIf
- Quit
- EndScript
- Routine "Get_GFX.PREFS"
- WorkWithDocument "TEMP"
- Clear DOCUMENT
- InsertMessagePortList
- MoveCursorTo STARTOF DOCUMENT
- SplitLine
- MoveCursorTo STARTOF DOCUMENT
- SearchFor "CYBERGRAPHICS.LIBRARY",BYWORD NOCASE
- If SearchFound
- Let CYBERGFX=TRUE,DBLHEIGHT=TRUE,DBLWIDTH=TRUE
- Else
- Let CYBERGFX=FALSE
- EndIf
- EndScript
- Routine "IN_Case.WinX"
- Let WinX=Limit(0,ScreenWidth,Arg1)
- EndScript
- Routine "IN_Case.WinY"
- Let WinY=Limit(0,ScreenHeight,Arg1)
- EndScript
- Routine "IN_Case.WinH"
- Let WinH=Limit(177,ScreenHeight,Arg1)
- EndScript
- Routine "IN_Case.WinW"
- Let WinW=Limit(376,ScreenWidth,Arg1)
- EndScript
- Routine "GetColors"
- Let I=0
- Loop
- GetRGB I,R[I],G[I],B[I]
- Let I=I+1
- Until I>MaxColor
- EndScript
- Routine "ResetColors"
- Let I=0
- Loop
- SetRGB I,R[I],G[I],B[I]
- Let I=I+1
- Until I>MaxColor
- Do "SetProps"
- EndScript
- Routine "Box"
- Let Row=PenA%8
- Let Column=PenA//8
- Let Top=StartY+Row*IncY-1
- Let Left=StartX+Column*IncX-1
- Let APen=PenA
- SetPen Arg1
- DrawBorder Left,Top+1,IncX,IncY-1,BEVEL ,Arg1,2
- DrawBorder Left+3,Top+3,IncX-6,IncY-5,OUTLINE ,0,0
- SetPen APen
- EndScript
- Routine "SetProps"
- Let APen=PenA
- SetPen 1
- GetRGB APen,Red,Green,Blue
- Do "PrintPropPos"
- SetPropPosition "Prop_R",Red
- SetPropPosition "Prop_G",Green
- SetPropPosition "Prop_B",Blue
- SetPen APen
- EndScript
- Routine "PropRelease"
- Let APen=PenA
- SetPen 1
- Do "PrintPropPos"
- SetPen APen
- Let PendingCommand="None"
- EndScript
- Routine "Get_FONT.PREFS"
- Local READFILE="ENV:sys/font.prefs",X=0,SizeVar="",FontVar=""
- If EXISTS(READFILE)=TRUE
- IfError
- Let SysDefText="topaz",SysDefTextSize=8
- Else
- If FileSize(READFILE)>""
- GetFileInfo READFILE,FILECNT
- SetFileBufferSize Limit(1,1024,Integer(FILECNT%1024))
- OpenFile READFILE,"WORKFILE",READONLY ,OLDFILE
- FileReadChars "WORKFILE",X,223
- FileReadChars "WORKFILE",SizeVar,1,HEX
- FileReadChars "WORKFILE",X,2
- FileReadChars "WORKFILE",FontVar,30
- Let SysDefTextSize=HexToInteger(SizeVar)
- Let SysDefText=GetWord(FontVar,1,".")
- Close "WORKFILE"
- Else
- Let SysDefText="topaz",SysDefTextSize=8
- EndIf
- EndIf
- Else
- Let SysDefText="topaz",SysDefTextSize=8
- EndIf
- GetFontInfo SCREEN ,ScreenText,ScreenTextSize
- Let GOS=ScreenTextSize+3
- EndScript
- Routine "DrawPalette"
- Let MaxColor=WindowColors-1
- Let NumRows=WindowColors%8
- If NumRows=0
- Let NumRows=1
- Let NumCols=WindowColors
- Else
- Let NumCols=8
- EndIf
- Let StartX=11
- Let StartY=34
- Let IncX=(WinW-111)/NumCols
- Let IncY=(WinH-110)/NumRows
- Let I=0
- Let J=0
- Let X=0
- Let Y=0
- Loop
- Loop
- SetPen I+J*NumCols
- AreaRectangle StartX+X,StartY+Y,IncX-1,IncY-1
- Let I=I+1
- Let X=X+IncX
- Until I=NumCols
- Let I=0
- Let J=J+1
- Let X=0
- Let Y=Y+IncY
- Until J=NumRows
- EndScript
- Routine "SaveVar"
- Let PalData.WinX=WinX
- Let PalData.WinY=WinY
- Let PalData.WinW=WinW
- Let PalData.WinH=WinH
- SaveVariable PalData,"Ram:Pal.Data"
- EndScript
- Routine "LoadVar"
- If Exists("Ram:Pal.Data")
- Let PalData=LoadVariable("Ram:Pal.Data")
- IfError
- Let WinX=0,WinY=GOS,WinW=376,WinH=169+SCREENTEXTSIZE
- Else
- Let WinX=PalData.WinX,WinY=PalData.WinY,WinW=PalData.WinW,WinH=PalData.WinH
- EndIf
- ElseIf Exists(TheCurrentDirectory||"Pal.Data")
- Let PalData=LoadVariable(TheCurrentDirectory||"Pal.Data")
- IfError
- Let WinX=0,WinY=GOS,WinW=376,WinH=169+SCREENTEXTSIZE
- Else
- Let WinX=PalData.WinX,WinY=PalData.WinY,WinW=PalData.WinW,WinH=PalData.WinH
- EndIf
- Else
- Do "SaveVar"
- EndIf
- EndScript
- Routine "Get_TOOLTYPES"
- WorkWithDocument "ToolTypes"
- Clear DOCUMENT
- If Exists(DECKNAME||".info")
- LoadIcon DECKNAME,"ICON"
- IfError
- Do "LoadVar"
- Else
- WorkWithDocument "ToolTypes"
- Clear DOCUMENT
- InsertToolTypeList "ICON"
- MoveCursorTo STARTOF DOCUMENT
- If LINESINDOCUMENT>=2
- Loop
- If NOT Match(GetChars(THELINE,1,1),"(","[","{","<","«",";")
- Do "IN_Case."||UpperCase(GetWord(THELINE,1,"=")),UpperCase(GetWord(THELINE,1,"WwIiNnHhXxYy = "))
- IfError
- EndIf
- EndIf
- MoveCursor DOWN
- Until THELINENUMBER=LINESINDOCUMENT
- EndIf
- Flush "ICON"
- EndIf
- Else
- Do "LoadVar"
- EndIf
- EndScript
- Routine "SearchFor"
- WorkWithDocument "ToolTypes"
- MoveCursorTo STARTOF DOCUMENT
- SearchFor Arg1,NOCASE
- If SearchFound
- Let Word=GetWord(TheLine,1)
- If Word<>Arg1||Arg2
- If Match(GetChars(Word,1,1),"(","[","{","<","«",";")
- MoveCursorTo ENDOF DOCUMENT
- Else
- Delete LINE
- EndIf
- MoveCursorTo ENDOF DOCUMENT
- Type Arg1||Arg2,NEWLINE
- EndIf
- Else
- MoveCursorTo ENDOF DOCUMENT
- Type Arg1||Arg2,NEWLINE
- EndIf
- EndScript
- Routine "SaveIcon"
- Do "Get_TOOLTYPES"
- WorkWithDocument "ToolTypes"
- MoveCursorTo STARTOF DOCUMENT
- Let WinX=WindowX,WinY=WindowY,WinW=WindowWidth,WinH=WindowHeight
- Do "SearchFor","WinX=",WinX
- Do "SearchFor","WinY=",WinY
- Do "SearchFor","WinW=",WinW
- Do "SearchFor","WinH=",WinH
- SetToolTypeList DeckName,"ToolTypes"
- SaveIcon DeckName,DeckName
- EndScript
- Routine "DrawWin"
- SetDrawMode JAM2
- Let WinW=WindowWidth
- Let WinH=WindowHeight
- Do "DrawPalette"
- DrawBorder WinW-94,16+AY1,72,WinH-(90+AY1),BEVEL ,1,2
- SetPrintFont "topaz",8
- SetPen 1,0
- PrintText "R",8,WinH-68
- PrintText "G",8,WinH-52
- PrintText "B",8,WinH-36
- SetPen 0
- Do "Box",1
- Do "SetProps"
- Do "GetColors"
- Let PendingCommand="None"
- EndScript
- Routine "PrintPropPos"
- SetDrawMode JAM2
- PrintText FormatValue(Red,"000"),WinW-43,WinH-(51+AY1)
- PrintText FormatValue(Green,"000"),WinW-43,WinH-(37+AY1)
- PrintText FormatValue(Blue,"000"),WinW-43,WinH-(21+AY1)
- EndScript
- Routine "ClickColor"
- Do "Box",0
- Do "DrawPalette"
- Let CurX=MouseX
- Let CurY=MouseY
- Let CurRow=Min((CurY-StartY)%IncY+1,NumRows)
- Let CurCol=Min((CurX-StartX)%IncX+1,NumCols)
- Let PenNum=8*(CurRow-1)+(CurCol-1)
- GetRGB PenA,Red,Green,Blue
- If PendingCommand="Copy"
- SetRGB PenNum,Red,Green,Blue
- ElseIf PendingCommand="Exchange"
- GetRGB PenNum,Red2,Green2,Blue2
- SetRGB PenA,Red2,Green2,Blue2
- SetRGB PenNum,Red,Green,Blue
- ElseIf PendingCommand="Spread"
- Let PenDiff=Absolute(PenNum-PenA)
- If PenDiff>1
- Let StartPen=Min(PenA,PenNum)
- If StartPen=PenA
- GetRGB PenA,Red,Green,Blue
- GetRGB PenNum,Red2,Green2,Blue2
- Else
- GetRGB PenNum,Red,Green,Blue
- GetRGB PenA,Red2,Green2,Blue2
- EndIf
- Let RedInc=(Red2-Red)/PenDiff
- Let GreenInc=(Green2-Green)/PenDiff
- Let BlueInc=(Blue2-Blue)/PenDiff
- Let CurPen=StartPen+1
- While CurPen<=StartPen+PenDiff-1
- Let NewRed=Red+(CurPen-StartPen)*RedInc
- Let NewGreen=Green+(CurPen-StartPen)*GreenInc
- Let NewBlue=Blue+(CurPen-StartPen)*BlueInc
- SetRGB CurPen,NewRed,NewGreen,NewBlue
- Let CurPen=CurPen+1
- EndLoop
- EndIf
- EndIf
- SetPen PenNum
- Let PendingCommand="None"
- AreaRectangle WinW-90,18+AY1,64,WinH-(95+AY1)
- Do "SetProps"
- Do "Box",1
- EndScript
- Resource "PROGRAM"
- BeforeAttachment
- SetAutoFileRequester FALSE
- Do "Get_GFX.PREFS"
- Do "Get_FONT.PREFS"
- Let WinX=0,WinY=GOS,WinW=376,WinH=169+SCREENTEXTSIZE
- If THEPUBSCREENTITLE=""
- Let THEPUBSCREENTITLE="Workbench"
- Else
- Let THEPUBSCREENTITLE=Name
- EndIf
- Do "Get_TOOLTYPES"
- EndScript
- AfterAttachment
- SetAutoFileRequester FALSE
- SetSystemRequesterTo WINDOW
- Let WinBorT=WINDOWBORDERTOP
- Let DBLHEIGHT=IfThen(CYBERGFX=TRUE,TRUE,Interlace)
- Let DBLWIDTH=IfThen(CYBERGFX=TRUE,TRUE,Hires)
- Let Horiz=IfThen(DBLWIDTH=TRUE,8,4)
- Let Vert=IfThen(DBLHEIGHT=TRUE,4,4)
- Let AX1=Horiz+1
- Let AY1=WinBorT+Vert
- AttachObject "OBJECTS"
- Do "DrawWin"
- EndScript
- Window "MainWindow"
- Definition
- Origin WinX,WinY
- Title "Palette Deck..."
- WindowObjects CLOSEBUTTON DEPTHBUTTONS DRAGBAR SIZEBUTTON
- WindowLimits 376,169,ScreenWidth,ScreenHeight
- WindowZoom -1,-1,376,169
- Size WinW,WinH
- WindowFlags ACTIVATE TOFRONT PUBLIC ,THEPUBSCREENTITLE
- VisualEffects NONE ,NONE
- EndScript
- OnCloseButton
- Do "Quit"
- EndScript
- OnResized
- If ObjectAttached("OBJECTS")
- DetachObject "OBJECTS"
- ClearWindow
- AttachObject "OBJECTS"
- EndIf
- Do "DrawWin"
- EndScript
- EndObj
- Resource "OBJECTS"
- NoAttach
- BeforeAttachment
- Let WinW=WindowWidth
- Let WinH=WindowHeight
- EndScript
- AreaButton "B_Copy"
- Definition
- Origin AX1,AY1
- Border BEVEL ,2,4
- Text "Copy"
- Font "topaz",8
- Size 64,13
- EndScript
- OnRelease
- Let PendingCommand="Copy"
- EndScript
- AfterAttachment
- DrawBorder AX1,AY1,64,13,OUTLINE ,1,1
- EndScript
- EndObj
- AreaButton "B_Swap"
- Definition
- Origin Whole(79+((WinW-376)/2)/2),AY1
- Border BEVEL ,2,4
- Text "Swap"
- Font "topaz",8
- Size 64,13
- EndScript
- OnRelease
- Let PendingCommand="Exchange"
- EndScript
- AfterAttachment
- DrawBorder Whole(79+((WinW-376)/2)/2),AY1,64,13,OUTLINE ,1,1
- EndScript
- EndObj
- AreaButton "B_Spread"
- Definition
- Origin Whole(149+((WinW-376)/2)),AY1
- Border BEVEL ,2,4
- Text "Spread"
- Font "topaz",8
- Size 64,13
- EndScript
- OnRelease
- Let PendingCommand="Spread"
- EndScript
- AfterAttachment
- DrawBorder Whole(149+((WinW-376)/2)),AY1,64,13,OUTLINE ,1,1
- EndScript
- EndObj
- AreaButton "B_Screens"
- Definition
- Origin Whole(219+((WinW-376)/2)*5/3),AY1
- Border BEVEL ,2,4
- Text "Screens"
- Font "topaz",8
- Size 64,13
- EndScript
- OnRelease
- If Not ObjectAttached("Pub")
- AttachObject "Pub"
- EndIf
- WorkWithDocument "PubScreens"
- Clear DOCUMENT
- InsertPubScreenList
- Delete CHARACTER ,-1
- MoveCursorTo STARTOF DOCUMENT
- EndScript
- AfterAttachment
- DrawBorder Whole(219+((WinW-376)/2)*5/3),AY1,64,13,OUTLINE ,1,1
- EndScript
- EndObj
- AreaButton "B_Restore"
- Definition
- Origin WinW-87,AY1
- Border BEVEL ,2,4
- Text "Restore"
- Font "topaz",8
- Size 64,13
- EndScript
- OnRelease
- Do "ResetColors"
- Let PendingCommand="None"
- EndScript
- AfterAttachment
- DrawBorder WinW-87,AY1,64,13,OUTLINE ,1,1
- EndScript
- EndObj
- AreaButton "B_AreaPal"
- Definition
- Origin 8,16+AY1
- Border BEVEL
- Highlight NONE
- Size WinW-106,WinH-(90+AY1)
- EndScript
- OnClick
- Do "ClickColor"
- EndScript
- EndObj
- AreaButton "B_Save"
- Definition
- Origin AX1,WinH-(5+AY1)
- Border BEVEL ,2,4
- Text "Save"
- Font "topaz",8
- Size 58,13
- EndScript
- OnRelease
- ClipBrush 21,42,28,11,"PalBrush"
- SaveBrush "PalBrush",TheCurrentDirectory||"Pal.Prefs"
- EndScript
- AfterAttachment
- DrawBorder AX1,WinH-(5+AY1),58,13,OUTLINE ,1,1
- EndScript
- EndObj
- AreaButton "B_Use"
- Definition
- Origin Whole(152+((WinW-376)/2)),WinH-(5+AY1)
- Border BEVEL ,2,4
- Text "Use"
- Font "topaz",8
- Size 58,13
- EndScript
- OnRelease
- Do "Quit"
- EndScript
- AfterAttachment
- DrawBorder Whole(152+((WinW-376)/2)),WinH-(5+AY1),58,13,OUTLINE ,1,1
- EndScript
- EndObj
- AreaButton "B_Cancel"
- Definition
- Origin WinW-81,WinH-(5+AY1)
- Border BEVEL ,2,4
- Text "Cancel"
- Font "topaz",8
- Size 58,13
- EndScript
- OnRelease
- Do "ResetColors"
- Do "Quit"
- EndScript
- AfterAttachment
- DrawBorder WinW-81,WinH-(5+AY1),58,13,OUTLINE ,1,1
- EndScript
- EndObj
- AreaProp "Prop_R"
- Definition
- Origin 27,WinH-(53+AY1)
- Size WinW-74,9
- MoveType HORIZONTAL
- Range 0,255,1,10
- VisibleRange 1,1
- InitialPosition 1,1
- PropBorder No
- Image "Prop-a.br"
- AltImage "Prop-b.br"
- EndScript
- OnNewPosition
- GetPropPosition "Prop_R",NewPos
- GetRGB PenA,Red,Green,Blue
- SetRGB PenA,NewPos,Green,Blue
- Do "PrintPropPos"
- EndScript
- OnRelease
- Do "PropRelease"
- EndScript
- AfterAttachment
- DrawBorder 26,WinH-(54+AY1),WinW-74,11,DOUBLEBEVEL ,2,1
- EndScript
- EndObj
- AreaProp "Prop_G"
- Definition
- Origin 27,WinH-(36+AY1)
- Size WinW-74,9
- MoveType HORIZONTAL
- Range 0,255,1,10
- VisibleRange 1,1
- InitialPosition 1,1
- PropBorder No
- Image "Prop-a.br"
- AltImage "Prop-b.br"
- EndScript
- OnNewPosition
- GetPropPosition "Prop_G",NewPos
- GetRGB PenA,Red,Green,Blue
- SetRGB PenA,Red,NewPos,Blue
- Do "PrintPropPos"
- EndScript
- OnRelease
- Do "PropRelease"
- EndScript
- AfterAttachment
- DrawBorder 26,WinH-(37+AY1),WinW-74,11,DOUBLEBEVEL ,2,1
- EndScript
- EndObj
- AreaProp "Prop_B"
- Definition
- Origin 27,WinH-(19+AY1)
- Size WinW-74,9
- MoveType HORIZONTAL
- Range 0,255,1,10
- VisibleRange 1,1
- InitialPosition 1,1
- PropBorder No
- Image "Prop-a.br"
- AltImage "Prop-b.br"
- EndScript
- OnNewPosition
- GetPropPosition "Prop_B",NewPos
- GetRGB PenA,Red,Green,Blue
- SetRGB PenA,Red,Green,NewPos
- Do "PrintPropPos"
- EndScript
- OnRelease
- Do "PropRelease"
- EndScript
- AfterAttachment
- DrawBorder 26,WinH-(20+AY1),WinW-74,11,DOUBLEBEVEL ,2,1
- EndScript
- EndObj
- TextMenu "Load"
- Definition
- AttachTo MENU ,"Project..."
- Text "Load..."
- ShortCutKey "L"
- EndScript
- Occurred
- SetFileRequestMode REGULARMODE ,REJECTICONS PATTERNFIELD
- SetFileRequestPattern "#?.Prefs"
- Let FileName=AskForFileName(TheCurrentDirectory||".Prefs","Select Palette To Load...")
- If FileOf(FileName)<>Nothing
- ShowPalette FileName
- EndIf
- EndScript
- EndObj
- TextMenu "About"
- Definition
- AttachTo MENU ,"Project..."
- Text "About..."
- EndScript
- Occurred
- WorkWithDocument "TEMP"
- Clear DOCUMENT
- Type "Palette Deck Version 0.9",NEWLINE
- Type "By Thomas R. Grant",NEWLINE
- Type "tgrant@merlin.net.au",NEWLINE
- Type "http://arthur.merlin.net.au/~tgrant/",NEWLINE
- Local ©=AskForResponse(TextFromDocument("TEMP"),"about Palette Deck")
- EndScript
- EndObj
- Resource "Pub"
- NoAttach
- Memo "Screens"
- Definition
- MemoDocument "PubScreens"
- ScrollBars RIGHT
- InputStyle LOCKEDOUT
- Origin 10,WinH-(55+AY1)
- Size WinW-34,47
- Border INVERT BEVEL
- Font "topaz",8
- EndScript
- OnRelease
- WorkWithDocument "PubScreens"
- Let Name=GetWord(TheLine,1)
- If PubScreenExists(Name)
- Let THEPUBSCREENTITLE=Name
- If ObjectAttached("OBJECTS")
- DetachObject "PROGRAM"
- AttachObject "PROGRAM"
- EndIf
- EndIf
- EndScript
- EndObj
- EndObj
- EndObj
- EndObj
- EndObj
-