/ScriptServ

/*
* mIRC colour scheme sharing
* version 0.7.4
* created by thame^

* Licensed under the Creative Commons Attribution-NonCommercial-ShareAlike 2.5 License.
* Visit http://creativecommons.org/licenses/by-nc-sa/2.5/ to view the full license.
*/


; for thame.nl updater:
[_thupdate]
id=scheme
ver=0.7.4



; schemes are in the following format:
; mCS:<scheme name>,<event colours>:<rgb-values>:
;
; <scheme name> is mime-encoded.  the decoded (original) name may contain
; spaces but no commas.
; please note that although scheme names are allowed to contain
; wildcard characters (* and ?), this WILL screw up the script.
; there are currently no workarounds for this behaviour due to
; the way mIRC handles wildcards and /filter.
;
; <event colours> are encoded in base 16 (hex) in the following order:
;     background,action,ctcp,highlight,info,info2,invite,join,kick,mode,nick,
;     normal,notice,notify,other,own,part,quit,topic,wallops,whois,editbox,
;     editbox text,listbox,listbox text,gray,title,inactive
; as per the mirc.ini settings.  each colour is a single character, and are
; are not delimited in any way.
;
; <rgb-values> are 16 comma-seperated base 36 encoded rgb values of each of
; the 16 colours mIRC supports (from 0-15)
;
; the entire string should not contain any spaces



; $getscheme([scheme name])
; returns scheme data.  if no scheme name is supplied, currently used scheme is presumed.
; this identifier (unintentionally) accepts wildcards.
;
; $getscheme(<N>).item
; returns name of Nth scheme.  if N is 0, total number of schemes is returned.

alias getscheme {
  var %scheme
  if ($0) %scheme = $1
  else %scheme = $readini($mircini,text,theme)

  if ($0) && ($prop == item) {
    var %t = $ini($mircini,colors,0)
    if ($1 == 0) return %t
    elseif ($1 > %t) || ($1 < 0) return $false
    return $gettok($readini($mircini,colors,$ini($mircini,colors,$1)),1,44)
  }

  if ($isscheme(%scheme)) {
    var %i = $readini($mircini,colors,$v1), %name = $gettok(%i,1,44), %cl = $gettok(%i,2-,44), $&
      %rgb = $readini($mircini,palettes,$v1)
    return $markup(%name,%cl,%rgb)
  }
  else return $false
}


; $markup(<name>,<colours>,<rgb>)
; returns scheme data formatted accordingly

alias -l markup {
  var %cl, %rgb, %y = 2, %x = 1, %xmax = 28
  while (%y) {
    while (%x <= %xmax) {
      if (%y == 2) %cl = $+(%cl,$base($gettok($2,%x,44),10,16))
      elseif (%y == 1) %rgb = $+(%rgb,$iif(* iswm %rgb,$chr(44)),$base($gettok($3,%x,44),10,36))
      inc %x
    }
    var %x = 1, %xmax = 16
    dec %y
  }

  return $+(mCS:,$encode($1,m),$chr(44),%cl,:,%rgb,:)
}


; $mdecode by jaytea
; this is a modified version of jaytea's snippet, used here with permission.
; you can find the original version at http://www.mircscripts.org/comments.php?cid=3022

alias -l mdecode {
  bset -tc &_mcs.da 1 $1
  var %a = 1,%b,%c
  while ($bvar(&_mcs.da,%a)) {
    if ($poscs(ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/,$chr($v1))) $&
      %c = %c $+ $base($calc($v1 -1),10,2,6)
    if ($mid(%c,8,0)) {
      inc %b
      bset -c &_mcs.db %b $base($left(%c,8),2,10)
      %c = $mid(%c,9)
    }
    inc %a
  }
  return $bvar(&_mcs.db,1-).text
}


; $clnames
; returns comma-seperated colour names in order

alias -l clnames {
  var %names = background,action,ctcp,highlight,info,info2,invite,join,kick,mode,nick $+ $&
    ,normal,notice,notify,other,own,part,quit,topic,wallops,whois $+ $&
    ,editbox,editbox text,listbox,listbox text,gray,title,inactive
  return %names
}


; $isscheme(<scheme name>)
; checks if given scheme exists, returns ini item if it does

alias -l isscheme {
  if (!$0) return $false

  var %w = @_scheme, %i
  window -h %w
  loadbuf -rtcolors %w $+(",$mircini,")

  filter -wwc %w %w $+(n*=,$1,$chr(44),*)
  var %i = $gettok($line(%w,1),1,61)
  close -@ %w

  if (%i) return %i
  else return $false
}


; $getdat(<name|rgb|cl>,<scheme data>)
; extracts data from given scheme data
; can be either name, rgb or cl (for colours)

alias -l getdat {
  if ($1 == name) return $mdecode($right($gettok($2-,1,44),-4))
  else {
    var %i = $1
    tokenize 58 $gettok($mid($2,5,-1),2-,44)

    if (%i == cl) {
      var %x = 1, %t = $len($1), %cl
      while (%x <= %t) {
        %cl = $+(%cl,$iif(* iswm %cl,$chr(44)),$base($mid($1,%x,1),16,10))
        inc %x
      }
      return %cl
    }

    elseif (%i == rgb) {
      var %x = 1, %t = $numtok($2,44), %rgb
      while (%x <= %t) {
        %rgb = $+(%rgb,$iif(* iswm %rgb,$chr(44)),$base($gettok($2,%x,44),36,10))
        inc %x
      }
      return %rgb
    }
  }
}


; $checkscheme(<scheme data>)
; checks if given scheme data is valid ($true/$false)

alias -l checkscheme {
  if (mCS:* !iswmcs $1) || (*: !iswm $1-) || (* * iswm $1-) return $false

  var %name = $getdat(name,$1-), %cl = $getdat(cl,$1-), %rgb = $getdat(rgb,$1-)
  if (* !iswm %name) || (*,* iswm %name) || ($numtok(%cl,44) != 28) || ($numtok(%rgb,44) != 16) return $false

  var %y = 2, %x = 16
  while (%y) {
    while (%x) {
      if (%y == 1) && ($gettok(%cl,%x,44) !isnum 0-15) return $false
      elseif (%y == 2) && ($gettok(%rgb,%x,44) !isnum 0-16777215) return $false
      dec %x
    }
    %x = 28
    dec %y
  }

  return $true
}


; /savescheme [-un <scheme name>] <scheme data>
; saves given scheme data
; -u switch uses the given scheme after saving it
; -n switch overrides the scheme name encoded in the scheme data and
; uses <scheme name> instead

alias savescheme {
  var %use, %err = .echo -q, %name, %nname
  if ($show) && (!$isid) var %err = echo -ca ctcp * /savescheme:

  if (!$0) {
    %err insufficient parameters
    return $false
  }

  if (-* iswm $1) {
    if (*n* iswm $1) {
      %nname = $deltok($2-,-1,32)
      if (* !iswm %nname) {
        %err insufficient parameters
        return $false
      }
      if (*,* iswm %nname) {
        %err invalid scheme name
        return $false
      }
      tokenize 32 $1 $gettok($2-,-1,32)
    }
    if (-*u* iswm $1) %use = $true
    tokenize 32 $2-
  }

  if (!$checkscheme($1-)) {
    %err invalid format
    return $false
  }

  var %name = $iif(* iswm %nname,$v1,$getdat(name,$1-)), %cl = $getdat(cl,$1-), %rgb = $getdat(rgb,$1-)
  if ($isscheme(%name)) {
    %err scheme name already exists
    return $false
  }

  var %i = $+(n,$ini($mircini,colors,0)), %f = $+(",$mircini,")
  writeini %f colors %i $+(%name,$chr(44),%cl)
  writeini %f palettes %i %rgb

  if (%use) color -lrs %name
  if ($show) && (!$isid) echo -ca info * saved scheme $+(',%name,')

  return $true
}


; preview stuff
; pls2note that I'm lousy at picture windows

; /schemepreview [-f] <scheme data>
; generates a preview for the given scheme data, identical to the one in
; the 'mIRC Colors' dialog (ALT+K).  shows the preview in a window by default
; -f switch saves the preview to a file instead of showing the window.  filename
; is returned if successful

alias schemepreview {
  var %w = $+(@Scheme,$chr(160),Preview:), %file, %wi = 306, %hi = 191
  if ($1 == -f) {
    var %file = $+(",$scriptdir,_mcs_preview.bmp,")
    tokenize 32 $2-
  }

  if (!$checkscheme($1-)) return $false

  if ($window(%w)) close -@ %w
  if (%file) window -pfzk0h %w -1 -1 %wi %hi
  else window -Cpfdzk0h +Lt %w -1 -1 %wi %hi
  titlebar %w $getdat(name,$1-)

  tokenize 32 $getdat(cl,$1-) $getdat(rgb,$1-)

  ; borders:
  var %hsep = $calc(%hi - 18), %vsep = 215, %vsep2 = $int($calc(%wi / 2))

  ; background
  drawrect -nrf %w $gcl(background,$1,$2) 0 0 0 %vsep %hsep
  ; listbox
  drawrect -nrf %w $gcl(listbox,$1,$2) 0 %vsep 0 %wi %hsep
  ; editbox
  drawrect -nrf %w $gcl(editbox,$1,$2) 0 0 %hsep %vsep2 %hi
  ; inactive editbox
  drawrect -nrf %w $gcl(inactive,$1,$2) 0 %vsep2 %hsep %wi %hi

  ; horizontal sep
  drawline -nr %w $rgb(face) 4 0 %hsep %wi %hsep
  ; vertical sep
  drawline -nr %w $rgb(face) 4 %vsep 0 %vsep %hsep
  ; vertical sep (in editbox)
  drawline -nr %w $rgb(face) 4 %vsep2 %hsep %vsep2 %hi


  var %txt = Action,Ctcp,Highlight,Info,Info2,Invite,Join,Kick,Mode,Nick,Normal $&
    ,Notice,Notify,Other,Own,Part,Quit,Topic,Wallops,Whois $&
    ,Listbox,Gray,Title

  var %x = 1, %t = $numtok(%txt,44), %cx = 5, %cy = 2
  while (%x <= %t) {
    if (%x == 12) var %cx = 120, %cy = 2
    elseif (%x == 21) var %cx = 221, %cy = 2

    var %i = $gettok(%txt,%x,44)
    if (%i == Listbox) %i = Listbox text

    drawtext -nro %w $gcl(%i,$1,$2) "MS Sans Serif" 8 %cx %cy $gettok(%txt,%x,44) text

    inc %cy 15
    inc %x
  }

  ; editbox text
  drawtext -nro %w $gcl(editbox text,$1,$2) "MS Sans Serif" 8 5 $calc(%hsep + 4) Editbox text
  ; inactive editbox text
  drawtext -nro %w $gcl(editbox text,$1,$2) "MS Sans Serif" 8 $calc(%vsep2 + 5) $calc(%hsep + 4) Inactive

  drawdot %w

  if (%file) {
    drawsave %w %file
    close -@ %w
    return %file
  }
  else return $true
}


; $gcl(<name>,<colours>,<rgb values>)
; returns rgb value of given colour entry name based on supplied colours and rgb values.. phew
; you shouldn't need this

alias -l gcl return $gettok($$3,$calc($gettok($2,$findtok($clnames,$1,1,44),44) + 1),44)


; this makes sure the preview window closes when it loses focus,
; or when the ESC key is pressed

menu @Scheme?Preview? {
  &Close:close -@ $menu
}
on *:keydown:@Scheme?Preview?:27:{
  var %w = $+(@Scheme,$chr(160),Preview:)
  if ($target == %w) close -@ %w
}
on *:active:*:{
  var %w = $+(@Scheme,$chr(160),Preview:)
  if ($lactive == %w) close -@ %w
}
on *:appactive:{
  var %w = $+(@Scheme,$chr(160),Preview:)
  if (!$appactive) && ($window(%w)) close -@ %w
}


; ### interface stuff starts here ###

; popups

menu menubar,status,channel,query {
  mIRC Colour &Scheme
  .$iif(($active == Status Window) || (!$server),$style(2)) Spa&m scheme
  ..$submenu($mcs_sub($1))
  .Copy current scheme to &clipboard:clipboard $getscheme
  .-
  .Sa&ve scheme...:{
    var %e = $cb
    :start
    var %d = $input(Please enter a valid mIRC Colour Scheme to save:,ei,Save mIRC Colour Scheme,%e)
    :check
    if (!%d) return
    if (!$checkscheme(%d)) {
      .echo -q $input(The data you have entered is not a valid mIRC Colour Scheme.,oh,Scheme Saving Error)
      %e = %d
      goto start
    }

    mcs_save %d
  }
  .Show &preview of scheme...:{
    var %e = $cb
    :start
    var %d = $input(Please enter a valid mIRC Colour Scheme to preview:,ei,Preview mIRC Colour Scheme,%e)
    if (%d) && (!$schemepreview(%d)) {
      if (!$schemepreview($getscheme(%d))) {
        .echo -q $input(The data you have entered is not a valid mIRC Colour Scheme.,oh,Scheme Preview Error)
        %e = %d
        goto start
      }
    }
  }
}


; $submenu that lists all available schemes

alias -l mcs_sub {
  if ($getscheme($1).item) {
    var %scheme = $v1, %current = $readini($mircini,text,theme)
    return $+($iif(%scheme == %current,$style(1)) %scheme,:spamscheme %scheme)
  }
}


; /spamscheme [scheme name]
; /says the given scheme, assumes current scheme if none is given

alias spamscheme {
  if (!$0) say $getscheme
  elseif ($getscheme($1-)) say $v1
}


; hotlink events

on ^*:hotlink:*mCS?*,?????????????????????????????*,*,*,*,*,*,*,*,*,*,*,*,*,*?:*:return
on *:hotlink:*mCS?*,?????????????????????????????*,*,*,*,*,*,*,*,*,*,*,*,*,*?:*:{
  var %scheme = $gettok($hotline,$gettok($hotlinepos,1,32),32)
  mcs_save %scheme
}


; nifty saving dialog stuff

; /mcs_save <scheme data>
; opens up the save dialog with the given scheme data

alias -l mcs_save {
  var %d = mCS_save
  if (!$checkscheme($1-)) return $false
  if ($dialog(%d)) dialog -x %d
  set %__mCS:_save $1-
  .echo -q $dialog(%d,%d)
  unset %__mCS:_save
}

dialog -l mCS_save {
  title "Save mIRC Colour Scheme"
  size -1 -1 167 147
  option dbu
  text "Scheme &name:", 1, 7 5 40 8
  edit "", 2, 51 4 109 10, autohs
  icon 3, 7 20 153 96
  check "&Use this scheme", 4, 7 120 60 10
  button "&Cancel", 5, 124 132 37 12, cancel
  button "&Save", 6, 83 132 37 12, default ok
  text "", 7, 1 1 1 1, hide
}

on *:dialog:mCS_save:*:*:{
  if ($devent == init) {
    var %scheme = %__mCS:_save
    did -ra $dname 7 %scheme
    did -ra $dname 2 $getdat(name,%scheme)
    did -g $dname 3 $schemepreview(-f,%scheme)
  }
  if ($devent == sclick) && ($did == 6) {
    var %name = $did($dname,2)
    if (*,* iswm %name) {
      did -f $dname 2
      halt $input(Invalid scheme name. Please enter a different scheme name.,ohu,Scheme Saving Error))
    }
    elseif ($isscheme(%name)) {
      did -f $dname 2
      halt $input(This scheme name exists. Please enter a different scheme name.,ohu,Scheme Saving Error))
    }
    else {
      var %d = $did($dname,7), %cl = $getdat(cl,%d), %rgb = $getdat(rgb,%d)
      .savescheme $iif($did($dname,4).state,-u) $markup(%name,%cl,%rgb)
      if ($result) return $input(Scheme saved as $+(',%name,'),oiu,Scheme Saved))
      else return $input(Oops! Something went wrong with saving this scheme..,oh,Scheme Saving Error)
    }
  }
  if ($devent == close) .remove $+(",$gettok($did($dname,3),2-,32),")
}