From df67041a11a771294cc387b6fef6964c175cc0c3 Mon Sep 17 00:00:00 2001 From: John Benediktsson Date: Mon, 22 Jan 2018 07:39:29 -0800 Subject: [PATCH] bubble-chamber: adjust for gl-scale-factor. --- extra/bubble-chamber/bubble-chamber.factor | 30 ++++++++++++++-------- 1 file changed, 19 insertions(+), 11 deletions(-) diff --git a/extra/bubble-chamber/bubble-chamber.factor b/extra/bubble-chamber/bubble-chamber.factor index 8e0509b61d..fb6acb5579 100644 --- a/extra/bubble-chamber/bubble-chamber.factor +++ b/extra/bubble-chamber/bubble-chamber.factor @@ -1,8 +1,8 @@ USING: accessors arrays calendar colors colors.gray combinators.short-circuit frame-buffer kernel locals math math.constants math.functions math.libm math.order math.points -math.ranges math.vectors namespaces processing.shapes random -sequences threads ui ui.gadgets ui.gestures ; +math.ranges math.vectors namespaces opengl processing.shapes +random sequences threads ui ui.gadgets ui.gestures ; IN: bubble-chamber @@ -25,6 +25,14 @@ IN: bubble-chamber : mouse-x ( -- x ) mouse first ; : mouse-y ( -- y ) mouse second ; +: draw ( point -- ) + gl-scale-factor get-global [ + stroke-color get fill-color set + >integer draw-circle + ] [ + draw-point + ] if* ; + GENERIC: collide ( particle -- ) GENERIC: move ( particle -- ) @@ -103,13 +111,13 @@ M: axion collide : axion-white ( dy -- dy ) dup 1 swap dy>alpha gray boa stroke-color set ; : axion-black ( dy -- dy ) dup 0 swap dy>alpha gray boa stroke-color set ; -: axion-point- ( particle dy -- particle ) [ dup pos>> ] dip v-y draw-point ; -: axion-point+ ( particle dy -- particle ) [ dup pos>> ] dip v+y draw-point ; +: axion-point- ( particle dy -- particle ) [ dup pos>> ] dip v-y draw ; +: axion-point+ ( particle dy -- particle ) [ dup pos>> ] dip v+y draw ; M: axion move T{ gray f 0.06 0.59 } stroke-color set - dup pos>> draw-point + dup pos>> draw 1 4 [a,b] [ axion-white axion-point- ] each 1 4 [a,b] [ axion-black axion-point+ ] each @@ -155,8 +163,8 @@ M: hadron collide M: hadron move - T{ gray f 1 0.11 } stroke-color set dup pos>> 1 v-y draw-point - T{ gray f 0 0.11 } stroke-color set dup pos>> 1 v+y draw-point + T{ gray f 1 0.11 } stroke-color set dup pos>> 1 v-y draw + T{ gray f 0 0.11 } stroke-color set dup pos>> 1 v+y draw dup vel>> move-by @@ -243,10 +251,10 @@ M:: muon move ( MUON -- ) MUON dup myc>> >rgba-components drop 0.16 stroke-color set - dup pos>> draw-point + dup pos>> draw dup mya>> >rgba-components drop 0.16 stroke-color set - dup pos>> first2 [ WIDTH swap - ] dip 2array draw-point + dup pos>> first2 [ WIDTH swap - ] dip 2array draw dup [ speed>> ] [ theta>> [ sin ] [ cos ] bi 2array ] bi n*v @@ -283,9 +291,9 @@ M:: quark move ( QUARK -- ) QUARK dup myc>> >rgba-components drop 0.13 stroke-color set - dup pos>> draw-point + dup pos>> draw - dup pos>> first2 [ WIDTH swap - ] dip 2array draw-point + dup pos>> first2 [ WIDTH swap - ] dip 2array draw [ ] [ vel>> ] bi move-by