home *** CD-ROM | disk | FTP | other *** search
/ AMOS PD CD / amospdcd.iso / 601-625 / apd616 / source / wbcolours_proc_addon.amos / wbcolours_proc_addon.amosSourceCode
AMOS Source Code  |  1978-01-03  |  1KB  |  57 lines
  1. Procedure _GETWBPALETTE
  2.    '
  3.    F$=""
  4.    OK=0
  5.    '
  6.    If Exist("Env:Sys/Palette.prefs")
  7.       F$="Env:Sys/Palette.prefs"
  8.       OK=1
  9.    End If 
  10.    '
  11.    If F$="" and Exist("ENVARC:Sys/Palette.prefs")
  12.       F$="EnvArc:Sys/Palette.prefs"
  13.       OK=1
  14.    End If 
  15.    '
  16.    If F$="" and Exist("Devs:System-Configuration")
  17.       F$="Devs:System-Configuration"
  18.       OK=2
  19.    End If 
  20.    '
  21.    If F$=""
  22.       Palette $999,$0,$FFF,$58A,$F00,$F0,$F,$FF0
  23.    End If 
  24.    '
  25.    ' *** Change To WB Colours.
  26.    '
  27.    If OK=1
  28.       '
  29.       Open In 1,F$
  30.       L=Lof(1)
  31.       Close 1
  32.       A$=Space$(L)
  33.       Bload F$,Varptr(A$)
  34.       For A=0 To 7
  35.          R=Peek(Varptr(A$)+180+A*8)/16
  36.          G=Peek(Varptr(A$)+182+A*8)/16
  37.          B=Peek(Varptr(A$)+184+A*8)/16
  38.          Colour A,(R*256+G*16+B)
  39.       Next A
  40.       A$=""
  41.       '
  42.    End If 
  43.    '
  44.    If OK=2
  45.       Open In 1,F$
  46.       L=Lof(1)
  47.       Close 1
  48.       A$=Space$(L)
  49.       Bload F$,Varptr(A$)
  50.       For A=0 To 3
  51.          Colour A,Deek(Varptr(A$)+110+A*2)
  52.          Colour A+16,Deek(Varptr(A$)+102+A*2)
  53.       Next A
  54.       A$=""
  55.    End If 
  56.    '
  57. End Proc