Skip to content

Commit

Permalink
tweak button look, get rid of dmgbuttons
Browse files Browse the repository at this point in the history
  • Loading branch information
@david-vanderson
david-vanderson committed Aug 15, 2018
1 parent 49fab72 commit be7aa15
Show file tree
Hide file tree
Showing 6 changed files with 67 additions and 127 deletions.
23 changes: 2 additions & 21 deletions client.rkt
View file
Expand Up @@ -1058,25 +1058,6 @@

(define sd (make-sprite-db))
(let ()
(add-sprite!/value sd 'button-normal
(inset (filled-rectangle 100 50 #:color "gray"
#:border-color "white" #:border-width 2) 1))
(add-sprite!/value sd 'button-outline
(inset (rectangle 100 50 #:border-color "gray" #:border-width 2) 1))
(add-sprite!/value sd 'button-disabled
(inset (filled-rectangle 100 50 #:color "black"
#:border-color "gray" #:border-width 2) 1))
(add-sprite!/value sd 'button-normal-circle
(inset (filled-ellipse 100 100 #:color "gray"
#:border-color "white" #:border-width 2) 1))
(add-sprite!/value sd 'button-disabled-circle
(inset (filled-ellipse 100 100 #:color "black"
#:border-color "gray" #:border-width 2) 1))
(add-sprite!/value sd 'dmgbutton-normal
(inset (rectangle 100 50 #:border-color "black" #:border-width 2) 1))
(add-sprite!/value sd 'dmgbutton-fill
(inset (filled-rectangle 100 50 #:color "black"
#:border-color "black" #:border-width 0) 2))
; used to draw lines
; we need multiple because:
; - scaling up causes fading at the edges
Expand Down Expand Up @@ -1154,15 +1135,15 @@

(add-sprite!/value sd 'intro (read-bitmap (build-path IMAGEDIR "intro.png") 'png/alpha))
)

(define textfont (load-font! sd #:size TEXTH #:face "Verdana" #:family 'modern))
(load-ships! sd)
(plasma-setup-pre! sd)
(explosion-setup-pre! sd)
(add-sprite!/file sd 'missile (build-path IMAGEDIR "missile.png"))
(add-sprite!/file sd 'cannonball (build-path IMAGEDIR "asteroid_43.png"))

(define csd (compile-sprite-db sd #:padding 2))
;(save-csd! csd "csd" #:debug? #t)

(plasma-setup-post! csd)
(explosion-setup-post! csd)
(define textr (make-text-aligned-renderer textfont csd))
Expand Down
4 changes: 0 additions & 4 deletions defs.rkt
View file
Expand Up @@ -411,7 +411,3 @@
; held is the keyboard shortcut (or 'mouse)
; key is the keyboard shortcut (for id purposes)
; frelease is the holdbutton-frelease function

(struct dmgbutton button (frac fixing?) #:mutable #:prefab)
; frac is percentage fixed
; fixing? is #t if this is being fixed
39 changes: 15 additions & 24 deletions draw-utils.rkt
View file
Expand Up @@ -15,6 +15,14 @@

(define mapcol (make-color 0 0 200 1.0)) ; sector lines
(define zoomcol (make-color 180 180 180 1.0)) ; zoom meter
(define button-txt (send the-color-database find-color "white"))
(define button-disable-txt (send the-color-database find-color "gray"))
(define button-dmg-txt (send the-color-database find-color "dimgray"))
(define button-normal (send the-color-database find-color "white"))
(define button-normal-fill (send the-color-database find-color "gray"))
(define button-outline (send the-color-database find-color "gray"))
(define button-disable (send the-color-database find-color "gray"))
(define button-disable-fill (send the-color-database find-color "black"))

(define canon-width 800.0)
(define canon-height 600.0)
Expand Down Expand Up @@ -151,26 +159,19 @@

(define (rect-outline csd x y w h thick layer
#:r [r 255] #:g [g 255] #:b [b 255] #:a [a 1.0])
(define-values (idx-w mx-w)
(if (w . > . 100.0)
(values (sprite-idx csd '1000x10) (/ (+ w thick) 1000.0))
(values (sprite-idx csd '100x10) (/ (+ w thick) 100.0))))
(define-values (idx-h mx-h)
(if (h . > . 100.0)
(values (sprite-idx csd '1000x10) (/ (+ h thick) 1000.0))
(values (sprite-idx csd '100x10) (/ (+ h thick) 100.0))))
(define idx (sprite-idx csd '1x1))
(define xoffs (list (/ w 2) (- (/ w 2))))
(define yoffs (list (/ h 2) (- (/ h 2))))
(append
(for/list ((xoff xoffs))
(sprite (+ x xoff) y idx-h
(sprite (+ x xoff) y idx
#:layer layer
#:mx mx-h #:my (/ thick 10.0) #:theta pi/2
#:mx thick #:my (+ h thick)
#:r r #:g g #:b b #:a a))
(for/list ((yoff yoffs))
(sprite x (+ y yoff) idx-w
(sprite x (+ y yoff) idx
#:layer layer
#:mx mx-w #:my (/ thick 10.0)
#:mx (+ w thick) #:my thick
#:r r #:g g #:b b #:a a))))

(define (rect-filled csd x y w h layer
Expand Down Expand Up @@ -215,17 +216,7 @@
alpha))


(define (add-offline-button! tool b send-commands (dmgstr "offline"))
(define (button-set-dmg! tool b (dmgstr "offline"))
(define offline (findf (lambda (d) (equal? dmgstr (dmg-type d))) (tool-dmgs tool)))
(cond
(offline
(set-button-draw! b 'dmg)
(dmgbutton 'normal #f #f
(button-x b) (- (button-y b) (button-height b))
(button-width b) (button-height b)
"Offline"
(lambda (x y) (void))
(/ (dmg-energy offline) (dmg-size offline)) (dmg-fixing? offline)))
(else
#f)))
(when offline (set-button-draw! b 'dmg)))

112 changes: 42 additions & 70 deletions draw.rkt
View file
Expand Up @@ -342,16 +342,27 @@
(define-values (x y w h) (values (exact->inexact (button-x b))
(exact->inexact (button-y b))
(exact->inexact (button-width b))
(button-height b)))
(exact->inexact (button-height b))))

(when h (set! h (exact->inexact h)))
(define strs (string-split (button-label b) "\n"))

(define sprname (if (dmgbutton? b) 'dmgbutton-normal 'button-normal))
(define txtcol 255)
(define col button-normal)
(define fill button-normal-fill)
(define txtcol button-txt)
(cond
((member (button-draw b) '(outline))
(set! sprname 'button-outline))
((or (member (button-draw b) '(disabled dmg))
(set! col button-outline)
(set! fill #f))
((member (button-draw b) '(dmg))
(set! fill button-disable-fill)
(set! txtcol button-dmg-txt)
(define br (if (time-toggle time 1000) 255 100))
(set! col (make-color br 0 0 1.0))
(set! strs (cons "" strs))
(prepend! spr (textr "Offline" x (+ y (- (* 10.0 (- (length strs) 1))) 2.0)
#:layer LAYER_UI_TEXT
#:r br)))
((or (member (button-draw b) '(disabled))
(if (holdbutton? b)
; if we are holding the button, draw it as pressed
(ormap (lambda (h)
Expand All @@ -361,35 +372,27 @@
(ormap (lambda (p)
(equal? (press-key p) (button-key b)))
pressed)))
(set! sprname 'button-disabled)
(set! txtcol 150)))

(when (not h)
(set! sprname (string->symbol (string-append (symbol->string sprname) "-circle"))))

(define br 0)
(when (dmgbutton? b)
(set! br
(if (dmgbutton-fixing? b) 255
(if (time-toggle time 1000) 255 100)))
(prepend! spr (sprite x y (sprite-idx csd 'dmgbutton-fill) #:layer LAYER_UI
#:mx (/ w (sprite-width csd (sprite-idx csd 'dmgbutton-fill)) 1.0)
#:my (/ (exact->inexact (* h (dmgbutton-frac b)))
(sprite-height csd (sprite-idx csd 'dmgbutton-fill)) 1.0)
#:r br))
)

(prepend! spr (sprite x y (sprite-idx csd sprname) #:layer LAYER_UI
#:mx (/ w (sprite-width csd (sprite-idx csd sprname)) 1.0)
#:my (/ (if h h w) (sprite-height csd (sprite-idx csd sprname)) 1.0)
#:r br))

(define strs (string-split (button-label b) "\n"))
(set! col button-disable)
(set! fill button-disable-fill)
(set! txtcol button-disable-txt)))

(prepend! spr (rect-outline csd x y w h 2.0 LAYER_UI
#:r (send col red)
#:g (send col green)
#:b (send col blue)))
(when fill
(prepend! spr (rect-filled csd x y w h LAYER_UI
#:r (send fill red)
#:g (send fill green)
#:b (send fill blue))))

(for ((str strs)
(i (in-naturals)))
(prepend! spr (textr str x (+ y (- (* 10.0 (- (length strs) 1))) (* 20.0 i))
#:layer LAYER_UI_TEXT
#:r txtcol #:g txtcol #:b txtcol))))
#:r (send txtcol red)
#:g (send txtcol green)
#:b (send txtcol blue)))))
spr)


Expand Down Expand Up @@ -458,8 +461,7 @@
(and (warping? ship) (not (tool-while-warping? t))))
(set-button-draw! b 'disabled))
(prepend! buttons (list b))
(define ob (add-offline-button! t b send-commands))
(when ob (prepend! buttons (list ob))))
(button-set-dmg! t b))
((pbolt)
(define b (button 'disabled -1 #f (- (right) 58) (- (bottom) 28) 100 40 "Plasma" #f))
(when (and (not (equal? 'pbolt (unbox active-mouse-tool)))
Expand All @@ -474,8 +476,7 @@
#:mx (* f 10.0)
#:my 4.0
#:r 255))
(define ob (add-offline-button! t b send-commands))
(when ob (prepend! buttons (list ob))))
(button-set-dmg! t b))
((warp)
(define-values (bs ss) (draw-warp-ui! csd center scale space ship t stack send-commands))
(prepend! buttons bs)
Expand All @@ -489,8 +490,7 @@
(and (warping? ship) (not (tool-while-warping? t))))
(set-button-draw! b 'disabled))
(prepend! buttons b)
(define ob (add-offline-button! t b send-commands))
(when ob (prepend! buttons ob)))
(button-set-dmg! t b))

(let ()
(define b (button 'normal #\e #f (- (right) 58) (- (bottom) 124) 100 40 "Missile [e]"
Expand All @@ -500,17 +500,15 @@
(and (warping? ship) (not (tool-while-warping? t))))
(set-button-draw! b 'disabled))
(prepend! buttons b)
(define ob (add-offline-button! t b send-commands))
(when ob (prepend! buttons ob))))
(button-set-dmg! t b)))
((probe)
(define b (button 'normal #\x #f (- (right) 58) (- (bottom) 76) 100 40 "Probe [x]"
(lambda (x y) (send-commands (command pid cmdlevel (tool-name t) #t)))))
(when (or (not (ship-flying? ship))
(and (warping? ship) (not (tool-while-warping? t))))
(set-button-draw! b 'disabled))
(prepend! buttons b)
(define ob (add-offline-button! t b send-commands))
(when ob (prepend! buttons ob)))
(button-set-dmg! t b))
((cannon)
(define b (holdbutton 'normal #\c #f (- (right) 58) (- (bottom) 172) 100 40 "Cannon [c]"
(lambda (x y) (send-commands (command pid cmdlevel (tool-name t) (obj-r (get-ship stack)))))
Expand All @@ -519,8 +517,7 @@
(and (warping? ship) (not (tool-while-warping? t))))
(set-button-draw! b 'disabled))
(prepend! buttons b)
(define ob (add-offline-button! t b send-commands))
(when ob (prepend! buttons ob)))
(button-set-dmg! t b))
((endrc)
(define life (/ (max 0 ((tool-rc t) . - . (/ (obj-age space ship) 1000.0)))
(tool-rc t)))
Expand All @@ -534,37 +531,12 @@
(define b (button 'normal #\s #f 0 (- (bottom) 101) 100 40 "Stop [s]"
(lambda (x y)
(send-commands (endrc pid #t)))))
(prepend! buttons b))
#;((steer? t)
(define offline (findf (lambda (d) (equal? "offline" (dmg-type d))) (tool-dmgs t)))
(when offline
(define ob (dmgbutton 'normal #f #f
0.0 (- (bottom) 105) 200 30
"Steer Offline"
(lambda (x y) (send-commands (command (ob-id offline)
(not (dmg-fixing? offline)))))
(/ (dmg-energy offline) (dmg-size offline)) (dmg-fixing? offline)))
(prepend! buttons (list ob))))
(prepend! buttons b))
((dock)
(when (can-launch? stack)
(define lb (button 'normal #\w #f 0 (- (bottom) 124) 120 40 "Launch [w]"
(lambda (x y) (send-commands (command pid cmdlevel (tool-name t) 'launch)))))
(prepend! buttons (list lb))
(define lob (add-offline-button! t lb send-commands "nolaunch"))
(when lob (prepend! buttons (list lob)))))

#;((shbolt? t)
(define ship (get-ship stack))
(define pod (get-pod stack))
(define b (button 'normal #\space #f (+ (left) 65) (- (bottom) 35) 50.0 50.0 "Shield [_]" #f))
(cond
((and (ship-flying? ship) ((pod-energy pod) . > . (shbolt-shield-size t)))
(define a (+ (obj-r ship) (pod-facing (get-pod stack))))
(set-button-f! b (lambda (x y) (send-commands (command (ob-id t) a)))))
(else
(set-button-draw! b 'disabled)))
(prepend! buttons (list b))
(define ob (add-offline-button! t b send-commands))
(when ob (prepend! buttons (list ob))))))
(button-set-dmg! t lb "nolaunch")))))
(values buttons spr))

11 changes: 6 additions & 5 deletions scenarios/asteroid-search.rkt
View file
Expand Up @@ -240,11 +240,12 @@
(define f (new-red-fighter))
(append! changes (chadd f (ob-id frig))))

(for ((f (ship-hangar eb)))
(when (and (not (ship-strategy f))
((current-strat-age ownspace f) . > . 10000))
; fighter has been docked without a strat, send them to scout again
(append! changes (new-strat (ob-id f) (scout-strat ownspace)))))
(when eb
(for ((f (ship-hangar eb)))
(when (and (not (ship-strategy f))
((current-strat-age ownspace f) . > . 10000))
; fighter has been docked without a strat, send them to scout again
(append! changes (new-strat (ob-id f) (scout-strat ownspace))))))

(define hb (find-top-id ownspace hidden-base-id))

Expand Down
5 changes: 2 additions & 3 deletions warp.rkt
View file
Expand Up @@ -58,7 +58,7 @@
(define w (* 2.0 (caddr vals)))
(define h 40.0)
(define x (+ (left) 8.0 (/ maxw 2.0)))
(define y (- (bottom) 164.0))
(define y (- (bottom) 124.0))
(define z (clamp 0.0 1.0 (/ w maxw)))

(define p (car stack))
Expand Down Expand Up @@ -97,6 +97,5 @@
(and (warping? ship) (not (tool-while-warping? t))))
(set-button-draw! b 'disabled))
(append! buttons b)
(define ob (add-offline-button! t b send-commands))
(when ob (append! buttons ob))
(button-set-dmg! t b)
(values buttons spr))

0 comments on commit be7aa15

Please sign in to comment.